AW: kartesisches produkt ergebnis mehr als 1.048.576 Z
17.11.2015 10:45:55
Anne
Hi Daniel,
der Code sieht jetzt wie folgt aus (was ich hinzugefügt habe, ist fett markiert):
Sub cart_prod()
Dim A As Long
Dim B As Long
Dim C As Long
Dim D As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim m As Long
Dim n As Long
Dim o As Long
Dim p As Long
Dim Zeile As Long
Zeile = 20
Application.ScreenUpdating = False
Sheets("Tabelle1").Select
With ActiveSheet
A = .Cells(Rows.Count, 1).End(xlUp).Row
'MsgBox i
B = .Cells(Rows.Count, 2).End(xlUp).Row
'MsgBox j
C = .Cells(Rows.Count, 3).End(xlUp).Row
'MsgBox k
D = .Cells(Rows.Count, 4).End(xlUp).Row
'MsgBox D
End With
m = 0
n = 0
o = 0
p = 0
For i = 2 To A
For j = 2 To B
For k = 2 To C
For l = 2 To D
Worksheets("Tabelle2").Cells(l + m, 4).Value = Worksheets("Tabelle1").Cells(l, 4). _
Value
Worksheets("Tabelle2").Cells(k + n, 3).Value = Worksheets("Tabelle1").Cells(k, 3). _
Value
Worksheets("Tabelle2").Cells(j + o, 2).Value = Worksheets("Tabelle1").Cells(j, 2). _
Value
Worksheets("Tabelle2").Cells(i + p, 1).Value = Worksheets("Tabelle1").Cells(i, 1). _
Value
If l + m > Zeile Then Worksheets("Tabelle3").Cells(l + m, 4).Value = Worksheets("Tabelle1"). _
Cells(l, 4).Value
If k + n > Zeile Then Worksheets("Tabelle3").Cells(k + n, 3).Value = Worksheets("Tabelle1"). _
Cells(k, 3).Value
If j + o > Zeile Then Worksheets("Tabelle3").Cells(j + o, 2).Value = Worksheets("Tabelle1"). _
Cells(j, 2).Value
If i + p > Zeile Then Worksheets("Tabelle3").Cells(i + p, 1).Value = Worksheets("Tabelle1"). _
Cells(i, 1).Value
n = n + 1
o = o + 1
p = p + 1
Next
m = m + l - 2
n = n - 1
Next
m = m + 1 - 1
n = n + k - 2
o = o - 1
Next
o = o + j - 2
p = p - 1
Next
Application.ScreenUpdating = True
End Sub