Option Explicit
Sub Wollmilch()
Eierlegend Sheets("Tabelle1"), 3, 4, 5, 6, _
"Stornobetrag", "Storno", "Rechnung", "Rechnungsbetrag", "Belastung", "Forderung"
'hier: Wo - in C,D,E,F - ersetze in C "Stornobetrag" durch "Storno", "Rechnung" durch "Rechnungsbetrag"
' - ggf. < 0 durch "Belastung" oder "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
|