Moin zusammen,
ich möchte die Spalte mit dem aktuellen Datum neben die fixierte Spalte scrollen.
Also, die Spalte mit dem aktuellen Datum rechts von Spalte I.
Gruß
Björn
Hallo Björn,
was hindert dich daran?
Moin!
Welches Inkrement haben die Daten? 1?
Dann kann man die Spalte einfach errechnen und per ActiveWindow.ScrollColumn = x oder Application.Goto Cells(1, x) Scroll:=True dahin hüpfen.
Alternativ kann man das Datum mittels Application.Match() suchen.
Die Suche mittels Range.Find ist bei Daten häufig unzuverlässig.
Gruß Ralf
Niemand .... ich vergaß zu erwähnen, dass ich Hilfe zur Codeerstellung benötige.
Hallo Björn,
dann solltest du mal etwas mehr über deine Datei verraten, oder, noch besser, eine Beispieldatei hochladen.
(12.02.2022, 12:00)RPP63 schrieb: [ -> ]Moin!
Welches Inkrement haben die Daten? 1?
Dann kann man die Spalte einfach errechnen und per ActiveWindow.ScrollColumn = x oder Application.Goto Cells(1, x) Scroll:=True dahin hüpfen.
Alternativ kann man das Datum mittels Application.Match() suchen.
Die Suche mittels Range.Find ist bei Daten häufig unzuverlässig.
Gruß Ralf
Moin,
ActiveWindow.ScrollColumn = 11, damit springe ich nur in die besagte Spalte ohne die Spalten mit dem aktuellen Datum mitzunehmen.
Application.Goto Cells(1, 11) Scroll:=True, Fehler beim Kompilieren, Syntaxfehler ... kein Plan
(12.02.2022, 12:05)Klaus-Dieter schrieb: [ -> ]Hallo Björn,
dann solltest du mal etwas mehr über deine Datei verraten, oder, noch besser, eine Beispieldatei hochladen.
Moin,
ok ... bei dem File handelt es sich um eine Ressourcenplanung.
Ich habe den Teil herauskopiert, wo in der Tabelle automatisch das aktuelle Datum gesucht wird und eingerahmt.
Jetzt möchte ich gerne, dass die Spalten mit dem aktuellen Datum rechts von der fixierten Spalte "I"steht.
Gruß
Björn
Hallo Björn,
das sollte funktionieren.
Code:
Application.Goto Reference:=ActiveCell, Scroll:=True
Code:
Private Sub Worksheet_Activate()
Dim cellule As Range
dercol = Cells(2, Columns.Count).End(xlToLeft).Column
Set cellule = Range(Cells(2, 10), Cells(2, dercol)).Find(Date, lookat:=xlWhole)
If cellule Is Nothing Then MsgBox Date & " nicht gefunden!": Exit Sub 'hinzugefügt am 11.02.2022
colonne_inf = cellule.Column
colonne_sup = colonne_inf + 1
Range(Columns(colonne_inf), Columns(colonne_sup)).Activate
Application.Goto Reference:=ActiveCell, Scroll:=True
With Selection.Borders(xlEdgeLeft) 'hinzugefügt am 12.02.2022
.Color = RGB(255, 0, 0)
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.Color = RGB(255, 0, 0)
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.Color = RGB(255, 0, 0)
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.Color = RGB(255, 0, 0)
.Weight = xlThick
End With
End Sub
Oder Kürzer:
Code:
Application.Goto Reference:=cellule, Scroll:=True
Code:
Private Sub Worksheet_Activate()
Dim cellule As Range
dercol = Cells(2, Columns.Count).End(xlToLeft).Column
Set cellule = Range(Cells(2, 10), Cells(2, dercol)).Find(Date, lookat:=xlWhole)
If cellule Is Nothing Then MsgBox Date & " nicht gefunden!": Exit Sub 'hinzugefügt am 11.02.2022
Application.Goto Reference:=cellule, Scroll:=True
colonne_inf = cellule.Column
colonne_sup = colonne_inf + 1
Range(Columns(colonne_inf), Columns(colonne_sup)).Activate
' Application.Goto Reference:=ActiveCell, Scroll:=True
With Selection.Borders(xlEdgeLeft) 'hinzugefügt am 12.02.2022
.Color = RGB(255, 0, 0)
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.Color = RGB(255, 0, 0)
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.Color = RGB(255, 0, 0)
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.Color = RGB(255, 0, 0)
.Weight = xlThick
End With
End Sub
Danke Karl!
Verstehe ich den Code so richtig, dass die aktiven Zellen so weit nach links scrollen, bis es nicht weitergeht?
Gruß
Björn
Hallo Björn,
mit gekürztem Code im Einzelschritt, ist es vielleicht für dich verständlicher.
Den Cursor in das Makro setzen, die Stelle innerhalb des Makro spielt keine Rolle, dann mit der Taste F8 im Einzelschritt durch das Makro gehen und sehen was sich in der Tabelle tut.
Code:
Option Explicit
Private Sub Worksheet_Activate()
Dim cellule As Range
Dim dercol As Long
Dim colonne_inf As Long
Dim colonne_sup As Long
dercol = Cells(2, Columns.Count).End(xlToLeft).Column
Set cellule = Range(Cells(2, 10), Cells(2, dercol)).Find(Date, lookat:=xlWhole)
If cellule Is Nothing Then MsgBox Date & " nicht gefunden!": Exit Sub 'hinzugefügt am 11.02.2022
colonne_inf = cellule.Column
colonne_sup = colonne_inf + 1
Range(Columns(colonne_inf), Columns(colonne_sup)).Activate
Selection.BorderAround _
ColorIndex:=3, Weight:=xlThick
Application.Goto Reference:=Selection, Scroll:=True
End Sub
Hallo Björn,
Nachtrag: Um den Rahmen vor dem schließen der Arbeitsmappe wieder zu entfernen, das folgendes Makro in "DieseArbeitsmappe"
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim cellule As Range
Dim dercol As Long
Dim colonne_inf As Long
Dim colonne_sup As Long
Application.EnableEvents = False
Worksheets("Planif_Ressources").Activate
dercol = Cells(2, Columns.Count).End(xlToLeft).Column
Set cellule = Range(Cells(2, 10), Cells(2, dercol)).Find(Date, lookat:=xlWhole)
If cellule Is Nothing Then MsgBox Date & " nicht gefunden!": Exit Sub 'hinzugefügt am 11.02.2022
colonne_inf = cellule.Column
colonne_sup = colonne_inf + 1
Range(Columns(colonne_inf), Columns(colonne_sup)).Activate
Selection.Borders.LineStyle = xlNone
Application.EnableEvents = True
End Sub