Scrollen von Spalten

[Björn.412]

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

[Klaus-Dieter]

Hallo Björn,

was hindert dich daran?

[RPP63]

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

[Björn.412]

Niemand .... ich vergaß zu erwähnen, dass ich Hilfe zur Codeerstellung benötige.

[Klaus-Dieter]

Hallo Björn,

dann solltest du mal etwas mehr über deine Datei verraten, oder, noch besser, eine Beispieldatei hochladen.

[Björn.412]

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

---

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

[hddiesel]

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

[Björn.412]

Danke Karl!

Verstehe ich den Code so richtig, dass die aktiven Zellen so weit nach links scrollen, bis es nicht weitergeht?

Gruß
Björn

[hddiesel]

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

[hddiesel]

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