Option Explicit
Private Sub CommandButton1_Click()
Dim eins As Object
Dim zwei As Object
Dim drei As Object
Dim vier As Object
Dim ende1 As Long
Dim ende2 As Long
Dim ende3 As Long
Dim ende4 As Long
Dim artikel()
Dim i As Long
Dim j As Long
Dim k As Long
Dim zusammensetzung()
Application.ScreenUpdating = False
Set eins = Worksheets(1)
Set zwei = Worksheets(2)
Set drei = Worksheets(3)
Set vier = Worksheets(4)
ende1 = eins.Cells(Rows.Count, 1).End(xlUp).Row 'belegte Zellen in Blatt 1
ReDim artikel(2, ende1)
For i = 2 To ende1
If eins.Cells(i, 1) <> "" Then
artikel(1, i - 1) = eins.Cells(i, 1)
artikel(2, i - 1) = 0
End If
Next i
ende2 = zwei.Cells(Rows.Count, 1).End(xlUp).Row
ReDim zusammensetzung(ende2, ende1)
For j = 1 To ende1
For i = 2 To ende2
If zwei.Cells(i, 1) <> "" Then
If j = 1 Then
zusammensetzung(i, 0) = zwei.Cells(i, 1)
Else
If artikel(1, j - 1) <> "" Then zusammensetzung(i, j - 1) = Application.WorksheetFunction.CountIf(zwei.Range(zwei.Cells(i, 2), zwei.Cells(i, 10)), artikel(1, j - 1))
End If
End If
Next i
Next j
ende3 = drei.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To ende3
For j = 2 To ende1
If drei.Cells(i, 1) = artikel(1, j - 1) Then
artikel(2, j - 1) = artikel(2, j - 1) + Application.WorksheetFunction.Sum(drei.Range("B:BB").Rows(i))
End If
Next j
Next i
ende4 = vier.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To ende4
For j = 1 To ende2
If vier.Cells(i, 1) = zusammensetzung(j, 0) Then
For k = 1 To ende1
artikel(2, k) = artikel(2, k) - (Application.WorksheetFunction.Sum(vier.Range("B:BB").Rows(i)) * zusammensetzung(j, k))
Next k
End If
Next j
Next i
'Werte wieder eintragen
j = 1
For i = 1 To ende1
If eins.Cells(i, 1) = artikel(1, j) Then
eins.Cells(i, 2) = artikel(2, j)
j = j + 1
End If
Next i
Set eins = Nothing
Set zwei = Nothing
Set drei = Nothing
Set vier = Nothing
Application.ScreenUpdating = True
End Sub
Dies ist der aktuelle Code, ich denke hier müssten einige Zeilen- bzw Spaltenreferenzen geändert werden. Sonst funktioniert der Code von der Logik her super. Leider weiß ich nicht an welchen Stellen ich die Anpassungen vornehmen muss.
Vielen Dank für die Hilfe,
Philipp
|