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?
[
Bild bitte so als Datei hochladen: Klick mich!]
[
Bild bitte so als Datei hochladen: Klick mich!]
Vielen Dank.
G.T.Schröder
Hallöchen,
kennst Du den Befehl Offset?
z.B.
msgbox range("A1").Offset(2,3).Address
oder
range("A1").Offset(2,3).select
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
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.
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.
Nochmals Danke für die Hilfe.
mit etwas probieren war das die Lösung:
Selection.Offset(0, 1).Select
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
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.