|
[Zitat:= Die Range ist bekannt. Die Werte liegen in C2:Z366]
Dann machen Dir das zunutze:
Option Explicit
Sub FürJedesArbeitsblatt()
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
For Each wks In ThisWorkbook.Worksheets 'Für jedes Arbeitsblatt der Arbeitsmappe
'Eine If-Bedingung hier, falls nicht jedes Arbeitsblatt verwendet werden soll
With wks
Call WerteErsetzen(.Range("C2:Z366"))
End With
Next wks
End Sub
Sub WerteErsetzen(ByRef rng As Excel.Range)
Dim vArr As Variant
Dim i As Long, ii As Long
i = 1
ii = 1
vArr = rng 'Range.Werte in 2diomensionales Array für Schleife mit Bedingung
For i = LBound(vArr, 1) To UBound(vArr, 1) Step 1 'Schleife für Zeilen
For ii = LBound(vArr, 2) To UBound(vArr, 2) Step 1 'Schleife für Spalten
vArr(i, ii) = IIf((vArr(i, ii) > 20), 1, 0) 'Bedingung: Wenn Wert > 20, schreibe 1, sonst schreibe 0
Next ii
Next i
rng.Resize(UBound(vArr, 1), UBound(vArr, 2)).Value = vArr 'neue Werte vom 2DArray -> Range("C2:Z366") zurückschreiben
End Sub
|