Blockweise scrollen - Ergänzung
WalterK
vor einiger Zeit habe ich hier im Forum einen Code erhalten mit dem ich blockweise scrollen kann. Läuft tadellos.
Jetzt geht es noch darum, dass sich jeweils die Zellen des Blockes, der sich aktuell unmittelbar unter der Zeile 2 befindet, farblich hinterlegt und die Zellen umrahmt werden.
Hier ist der Code, habe auch noch die Tabelle hochgeladen:
Option Explicit
Sub Test()
Dim rngVisibleRange As Range
Dim lngLetzte As Long, nCount As Long
Dim booGoErste As Boolean
Static rngAktuell As Range
Set rngVisibleRange = Range("A3", Cells(Rows.Count, 1)).SpecialCells(xlCellTypeVisible)
booGoErste = rngAktuell Is Nothing
If Not booGoErste Then
booGoErste = Intersect(rngAktuell, rngVisibleRange) Is Nothing
End If
If booGoErste Then
Set rngAktuell = rngVisibleRange
Set rngAktuell = rngAktuell.Cells(1, 1)
Application.Goto rngAktuell, True
Exit Sub
End If
lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row
nCount = rngAktuell.Row + 1
Do While rngAktuell.Row lngLetzte Then
Set rngAktuell = Range("A3", Cells(Rows.Count, 1)).SpecialCells(xlCellTypeVisible)
Set rngAktuell = rngAktuell.Cells(1, 1)
Application.Goto rngAktuell, True
End If
End Sub
Kann mir jemand weiterhelfen?
Besten Dank und Servus, Walter