Das Clever-Excel-Forum.de - Treffen
... 14.-16. September 2018 im Allgäu ...

[VBA] Makierung von mehreren Zellen (Varialble Anzahl) um eine Spalte nach Rechts?
#1
Moin,

Eventuell eine einfache Sache, aber ich bin nicht besonders gut in VBA.
Ich suche schon seit Stunden nach einer Lösung, um die Makierung von Zellen um eine Position nach Rechts zu versetzen.

Das Problem ist:
Es wird eine fortlaufende Tabelle erzeugt, in der immer neue Werte untereinander aufgelisted werden.
Per Makro kann ich zwar bei neuen Einträgen die Zellen in der Letzen Spalte markieren, möchte aber diese Markierung nun im VBA um eine Spalte nach rechts verschieben.
Siehe gestelltes Beispiel. Sprich wo immer diese Makierung ist, wie viele Zeilen sie auch immer hatt, um eine Position nach Rechts.

Kennt jemand eine eineache Lösung/Befehl im VBA der mir dieses ermöglichen kann?

?mage

?mage

Vielen Dank.
G.T.Schröder
to top
#2
Hallöchen,

kennst Du den Befehl Offset?

z.B.
msgbox range("A1").Offset(2,3).Address

oder
range("A1").Offset(2,3).select
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
to top
#3
Hi!
Ergänzend mal ohne Offset, denn die letzte Spalte muss ja ohnehin ermittelt werden:

Sub SchiebMal()
Dim lZeile As Long, lSpalte As Long
With Tabelle1
   lZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
   lSpalte = .Cells(lZeile, .Columns.Count).End(xlToLeft).Column
   .Range(.Cells(2, lSpalte), .Cells(lZeile, lSpalte)).Cut .Cells(2, lSpalte + 1)
End With
End Sub

Gruß Ralf
to top
#4
Hi Ralf,

(20.02.2016, 13:28)RPP63 schrieb:   .Range(.Cells(2, lSpalte), .Cells(lZeile, lSpalte)).Cut .Cells(2, lSpalte + 1)

ich mag mich irren, aber da stand doch nix von Inhalte verschieben, sondern nur von "Markierung versetzen", also nicht den Inhalt.
Gruß Ralf

?mage

Die deutsche Rechtschreibung ist Freeware, d.h. du kannst sie kostenlos nutzen.
Allerdings ist sie nicht Open Source, deswegen darfst du sie nicht verändern oder in veränderter Form veröffentlichen.
to top
#5
Moin,

vielen dank für die Antworten!


Ja Rabe, verschieben/Versetzen ist genau richtig!


So gleich mal ausprobieren was Ralf als möglichkeit geantwortet hat.
to top
#6
Nochmals Danke für die Hilfe.

mit etwas probieren war das die Lösung:

Selection.Offset(0, 1).Select
to top
#7
Hallo,

hier mal noch für alle vier Richtungen mit Überlauf zum anderen Ende:

Sub MarkierungVerschiebenNachLinks()
 Dim lngOffset As Long
 If TypeName(Selection) = "Range" Then
   With Selection
     lngOffset = -(.Column = 1) * (Columns.Count - .Columns.Count + 1) - 1
     .Offset(0, lngOffset).Select
   End With
 End If
End Sub

Sub MarkierungVerschiebenNachRechts()
 Dim lngOffset As Long
 If TypeName(Selection) = "Range" Then
   With Selection
     lngOffset = (.Column = (Columns.Count - .Columns.Count + 1)) * (Columns.Count - .Columns.Count + 1) + 1
     .Offset(0, lngOffset).Select
   End With
 End If
End Sub

Sub MarkierungVerschiebenNachOben()
 Dim lngOffset As Long
 If TypeName(Selection) = "Range" Then
   With Selection
     lngOffset = -(.Row = 1) * (Rows.Count - .Rows.Count + 1) - 1
     .Offset(lngOffset, 0).Select
   End With
 End If
End Sub

Sub MarkierungVerschiebenNachUnten()
 Dim lngOffset As Long
 If TypeName(Selection) = "Range" Then
   With Selection
     lngOffset = (.Row = (Rows.Count - .Rows.Count + 1)) * (Rows.Count - .Rows.Count + 1) + 1
     .Offset(lngOffset, 0).Select
   End With
 End If
End Sub

In der Beispielmappe wird die Steuerung automatisch auf die Tastenkombinationen ALT+Pfeiltaste gelegt:

Private Sub Workbook_Activate()
 'Makros Tastenkobinationen zuweisen
 Application.OnKey "%{LEFT}", "MarkierungVerschiebenNachLinks"
 Application.OnKey "%{RIGHT}", "MarkierungVerschiebenNachRechts"
 Application.OnKey "%{UP}", "MarkierungVerschiebenNachOben"
 Application.OnKey "%{DOWN}", "MarkierungVerschiebenNachUnten"
End Sub

Private Sub Workbook_Deactivate()
 'Zuweisungen wieder aufheben
 Application.OnKey "%{LEFT}"
 Application.OnKey "%{RIGHT}"
 Application.OnKey "%{UP}"
 Application.OnKey "%{DOWN}"
End Sub

Gruß Uwe


Angehängte Dateien
.xls   MarkierungVerschieben.xls (Größe: 31 KB / Downloads: 3)
to top
#8
Hallöchen,

mit Fehlertoleranz gehts auch einfach so:
Code:
Sub Nach_Rechts_Einfach()
On Error Resume Next
Selection.Offset(0, 1).Select
End Sub
Sub Nach_Links_Einfach()
On Error Resume Next
Selection.Offset(0, -1).Select
End Sub
Sub Nach_Oben_Einfach()
On Error Resume Next
Selection.Offset(-1, 0).Select
End Sub
Sub Nach_Unten_Einfach()
On Error Resume Next
Selection.Offset(1, 0).Select
End Sub


Aber: Mein spezieller Dank an Uwe, der hier eine tolle Tastensteuerung für Makros eingebaut hat.
Hab die Datei runtergeladen und werde das neue Wissen reichlich einsetzen.
to top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste