Option
Explicit
Sub
Wollmilch()
Eierlegend Sheets(
"Tabelle1"
), 3, 4, 5, 6, _
"Stornobetrag"
,
"Storno"
,
"Rechnung"
,
"Rechnungsbetrag"
,
"Belastung"
,
"Forderung"
End
Sub
Private
Sub
Eierlegend(Sh
As
Worksheet, ClmA
As
Long
, Clm1
As
Long
, Clm2
As
Long
, Clm3
As
Long
, _
A1
As
String
, E1
As
String
, A2
As
String
, E2
As
String
, Eg1
As
String
, Eg2
As
String
)
Dim
arrA()
As
Variant
Dim
arr1()
As
Variant
Dim
arr2()
As
Variant
Dim
arr3()
As
Variant
Dim
x
As
Long
Dim
arrBCD()
As
Variant
With
Sh
With
.Columns(ClmA)
x = .Cells(.Rows.Count).
End
(xlUp).Row
arrA = Range(.Cells(1), .Cells(x)).Value
End
With
arr1 = Range(.Columns(Clm1).Cells(1), .Columns(Clm1).Cells(x)).Value
arr2 = Range(.Columns(Clm2).Cells(1), .Columns(Clm2).Cells(x)).Value
arr3 = Range(.Columns(Clm3).Cells(1), .Columns(Clm3).Cells(x)).Value
For
x = LBound(arrA)
To
UBound(arrA)
If
arrA(x, 1) = A1
Then
arrA(x, 1) = E1
Else
If
arrA(x, 1) = A2
Then
If
IsNumeric(arr1(x, 1))
And
Not
IsNumeric(arr2(x, 1)) =
True
Then
arrA(x, 1) = E2
Else
If
arr3(x, 1) < 0
Then
arrA(x, 1) = Eg1
Else
arrA(x, 1) = Eg2
End
If
End
If
End
If
End
If
Next
x
.Columns(ClmA).Cells(1).Resize(UBound(arrA)).Value = arrA
End
With
End
Sub