Kommt m.E. auch auf die Dateistruktur und deren Zielsetzung an.
Ohne grossartige Fehlerbehandlung und einfache Wartbarkeit, könnte es so ausschauen:
Option Explicit
Sub loopedOffsetYellowFilteredCells()
Dim i As Long
Dim v As Variant
Dim s As String
Dim vonZeile As Long, bisZeile As Long
'
vonZeile = 1
bisZeile = 100
v = Array("A", "B", "D") 'vordefinierte Spalten
For i = LBound(v) To UBound(v)
s = v(i) & vonZeile & ":" & v(i) & bisZeile
Call Schengb(ActiveSheet, ActiveSheet.Range(s))
Next i
End Sub
Sub Schengb(ByRef wks As Excel.Worksheet, ByRef rng As Excel.Range)
With wks
If .AutoFilterMode Then .AutoFilterMode = False
'
rng.AutoFilter _
Field:=1, _
Criteria1:=vbYellow, _
Operator:=xlFilterCellColor
'
If Not Intersect(rng, rng.Offset(1, 0), rng.SpecialCells(xlCellTypeVisible)) Is Nothing Then
Intersect(rng, rng.Offset(1, 0), rng.SpecialCells(xlCellTypeVisible)).Offset(0, 22).Value = "Irgendein Text"
End If
'Filter entfernen
.AutoFilterMode = False
End With
End Sub
|