Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1456to1460
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

kartesisches produkt ergebnis mehr als 1.048.576 Z

kartesisches produkt ergebnis mehr als 1.048.576 Z
16.11.2015 11:50:27
Anne
Hallo zusammen,
ich brauche bitte eure Hilfe bei folgendem Problem:
ich habe per VBA ein kartesisches Produkt programmiert, dass zwar reibungslos funktioniert, allerdings nur, bis die 1.048.576 Zeilen erreicht sind.
Nun suche ich nach einer Möglichkeit durch einen weiteren Befehl die Ergebnisse automatisch auf einem neuen Tab fort zus chreiben, wenn die maximale Zeilenanzahl erreicht ist. Leider scheitere ich daran :(
Habt ihr eine Idee ?
Anbei eine Beispieldatei mit dem Code - in der Realität habe ich deutlich mehr Variablen und erwarte mindestens 1.844.528 Ergebniszeilen.
https://www.herber.de/bbs/user/101552.xlsm
Vielen Dank für eure Unterstützung,
Anne

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: kartesisches produkt ergebnis mehr als 1.048.576 Z
16.11.2015 12:08:14
Daniel
HI
wenn die Maximale Zeilenanzahl von Excel überschritten ist, dann müsstest du das Ergebnis auf einem neuen Blatt weiterschreiben
dh wenn die Variable "Zeile" deine Zielzeilennummer enthält, dann kannst du so umrechnen:
ZeileNeu = ((Zeile -1) Mod 1048576) + 1
das Blatt kannst du dann über den Index ansprechen, Standard ist Index 2, wenn die Zeilenzahl grösser als der Grenzwert ist, dann musst du auf das nächste Blatt wechseln, dh
Sheets(2 + Int((Zeile - 1) / 1048576)).Select

das Blatt muss natürlich vorhanden sein.
Gruß Daniel

Anzeige
AW: kartesisches produkt ergebnis mehr als 1.048.576 Z
16.11.2015 12:17:22
Anne
Hi Daniel,
vielen Dank für die schnelle Hilfe - könntest Du mir das eventuell in den Code einbauen.... ich befürhcte, ich schau schon zu lange drauf und seh den Wald vor lauter Bäumen nicht :)
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
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
Sheets("Tabelle1").Select
Cells(l, 4).Select
Selection.Copy
Sheets("Tabelle2").Select
Cells(l + m, 4).Select
ActiveSheet.Paste
Sheets("Tabelle1").Select
Cells(k, 3).Select
Selection.Copy
Sheets("Tabelle2").Select
Cells(k + n, 3).Select
ActiveSheet.Paste
Sheets("Tabelle1").Select
Cells(j, 2).Select
Selection.Copy
Sheets("Tabelle2").Select
Cells(j + o, 2).Select
ActiveSheet.Paste
Sheets("Tabelle1").Select
Cells(i, 1).Select
Selection.Copy
Sheets("Tabelle2").Select
Cells(i + p, 1).Select
ActiveSheet.Paste
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
Danke,
Anne

Anzeige
AW: kartesisches produkt ergebnis mehr als 1.048.576 Z
16.11.2015 12:59:17
Anne
Hi,
danke für den Tipp - habe mich dran versucht, jetzt funktioniert mein Code nicht mehr :
Worksheets("Tabelle1").Cells(l, 4).Copy
Worksheets("Tabelle2").Cells(l + m, 4).Paste
"Objekt unterstütz Eigenschaft oder Methode nicht"
Kannst Du mir sagen, woran es liegt ?
Danke,
Anne

Anzeige
AW: kartesisches produkt ergebnis mehr als 1.048.576 Z
16.11.2015 13:04:27
Daniel
HI
wende mal das Inhalte-Einfügen aus dem Kontextmenü an und zeichne es mit dem Recorder auf.
dann wirst du sehen, dass das Einfügen von Excelspezifischen Inhalten nicht einfach .Paste heißt sondern .PasteSpecial xlpasteAll
wenn du nur Werte überragen willst, kannst du auch .PasteSpecial xlpastevalues verwenden.
Du kannst die Werte aber auch direkt übertragen, ohne sie erst zu kopieren. dann reicht für Kopieren und einfügen dieser Einzeiler:
Worksheets("Tabelle2").Cells(l + m, 4).value = Worksheets("Tabelle1").Cells(l, 4).Value
Gruß Daniel

Anzeige
AW: kartesisches produkt ergebnis mehr als 1.048.576 Z
16.11.2015 13:12:05
Anne
Oh wow - danke :) das läuft ja 1000mal schneller :)
Versuch mich jetzt nochmal an dem max-Zeilen-Problem

AW: kartesisches produkt ergebnis mehr als 1.048.576 Z
16.11.2015 13:54:00
Anne
Hallo nochmal,
ich komme hier einfach nicht weiter.... wie kann ich "Zeile" als Variable deklarieren ?
Und an welcher Stelle muss ich das "If Zeile größer als 1048576 Then Worksheets("Tabelle3").Select" einsetzen.. ? Würde sich jemand erbarmen, meinen Code zu vervollständigen.... verschlankt sieht dieser nun so aus :
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
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
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

Vielen Dank,
Anne

Anzeige
AW: kartesisches produkt ergebnis mehr als 1.048.576 Z
16.11.2015 14:25:31
Daniel
Hi
nachdem du bereits 12 Variablen in deinem Makro deklariert hast, sollte das für dich eigentlich kein Problem darstellen.
die Zeile in welche du die Wert schreibst ist ja immer:
Spalte 4: l + m
Spalte 3: k + n
Spalte 2: j + o
Spalte 1: i + p
immer diese Summe musst du überprüfen, ob sie grösser ist als die Zeilenzahl auf deinem Blatt und dann entscheiden, ob sie auf das nächste Blatt geschrieben werden muss.
gruß Daniel

AW: kartesisches produkt ergebnis mehr als 1.048.576 Z
17.11.2015 10:14:40
Anne
Hallo schon wieder :)
ich habe mein Makro jetzt angepasst und das Kopieren auf ein neues Tabellenblatt funktioniert.
Allerdings schreibt das Makro auch weiterhin auf dem "alten" Tab weiter......
Warum ? Muss ich den If Then Befehl jetzt in jede Schleife einbauen ? Gibt es da nicht einen eleganteren Weg ?
Danke für eure Hilfe,
Anne

Anzeige
AW: kartesisches produkt ergebnis mehr als 1.048.576 Z
17.11.2015 10:41:36
Daniel
Hi
wie sieht dein Code aus?
was hast du wie wo eingebaut?
Gruß Daniel

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

Anzeige
AW: kartesisches produkt ergebnis mehr als 1.048.576 Z
17.11.2015 10:58:28
Daniel
Hi
würde ich im Prinzip so machen:
dim GrenzWert as Long 'Maximale Zeilenanzahl für ein Blatt
dim T as Long 'Blattnummer auf die geschrieben wird
GrenzWert = 20
For i = 2 To A
For j = 2 To B
For k = 2 To C
For l = 2 To D
Zeile = l + m
T = 2 + Int((Zeile - 1) / GrenzWert)
Zeile = ((Zeile - 1) Mod GrenzWert) + 1
Sheets("Tabelle" & T).Cells(Zeile, 4).Value = Sheets("Tabelle1").Cells(l, 4).Value
und das dann für jeden zu schreibenden Wert mit den geänderten Parameter wiederholen

Gruß Daniel

AW: kartesisches produkt ergebnis mehr als 1.048.576 Z
17.11.2015 11:02:05
Anne
... vielen dank für deine Unterstützung.. ich probiers gleich aus :)
viele grüße,
Anne
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige