Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
25.04.2024 21:06:05
Duplikate entfernen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1124to1128
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1124to1128
1124to1128
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Verschachtelte For Next Schleife zusammenfassen

Verschachtelte For Next Schleife zusammenfassen
Illusion
Hi
Ich habe ein Makro, das nach folgendem Schema aufgebaut ist:
Dim i%, j%, k%, Summe%
Dim ws As Worksheet
Set ws = Worksheets("Liste")
For i = 1 to 3
For j = 4 to 6
For k = 7 to 9
Summe= ws.cells(i, 2).value + ws.cells(j, 2).value + ws.cells(k, 2).value
Next k
Next j
Next i

Mein Problem ist, dass es bei mir nicht nur 3 For Next Schleifen sind sondern 15 und mir Excel immer abstürzt nach einer bestimmten Zeit beim Ausführen des Makros, was wie ich vermute daran liegt dass er mit der verarbeiteten Datenmenge vielleicht nicht klarkommt. (Endlosschleife ist im Makro nicht enthalten, habe ich mehrmals kontrolliert). Deshalb dachte ich, dass es vielleicht möglich wäre diese Art von Code zu vereinfachen, damit Excel weniger Rechenleistung braucht und das ganze vielleicht schafft?
mfg
Illusion
AW: Verschachtelte For Next Schleife zusammenfassen
17.12.2009 12:55:13
Tino
Hallo,
ich kann mir nicht vorstellen das Excel überfordert ist.
Mir gibt eher zu denken, dass Summe als Integer deklariert ist.
Versuche es mal mit Double Summe# oder Long Summe&
Auch die i, j und k Variablen kannst Du als Long deklarieren.
Gruß Tino
AW: Verschachtelte For Next Schleife zusammenfassen
18.12.2009 10:45:03
Illusion
Argh, dass hab ich davon dass ich ein kleines Beispiel schnell zusammengeschrieben habe um das Problem möglichst knapp darzustellen. Die Summe in meinem Makro ist auf Single definiert, das sollte also nicht das Problem sein denke ich. Außerdem wäre doch ansonsten eher eine Fehlermeldung zu erwarten, wenn der Bereich der Variablen überschritten wird, anstatt ein Absturz von Excel oder?
Anzeige
wie soll man helfen wenn...
18.12.2009 11:17:32
Tino
Hallo,
Du nicht Deinen richtigen Code zeigst und kurz erklärst was Du machen möchtest?
Ohne ein Beispiel wird man nichts sagen können,
ich habe schon Schleifen gebaut mit einigen Millionen Durchläufen ohne Absturz.
Ich lass die Frage mal offen.
Frohe Festtage wünscht Tino
läuft es durch, bei Einzelschritten (F8)? oT
18.12.2009 11:46:05
Björn
AW: wie soll man helfen wenn...
18.12.2009 12:37:17
Illusion
Ich wollte auch eigentlich nicht den ganzen Code schreiben weil ich hoffte das Problem durch eine Vereinfachung der For Next Schleifen zu lösen ^^""
Also der Code sieht wie folgend aus:
Sub Berechnung()
Dim a%, b%, c%, d%, e%, f%, g%, h%, i%, j%, k%, l%, m%, n%, o%, p%, q%
Dim lz_w%, Anzahl&, Setbonus%, Anzeige%, Speicheranzahl%
Dim ws As Worksheet
Dim ws_w As Worksheet
Dim ws_nw As Worksheet
Dim ws_l As Worksheet
Dim DPS(1 To 10001, 0 To 15) As Single
Dim Tausch As Boolean
Set ws = Worksheets("Eingabe")
Set ws_l = Worksheets("Liste")
If ws.Cells(7, 5).Value = "Ja" Then
Set ws_nw = Worksheets("Non-Weapons H")
Set ws_w = Worksheets("Weapons H")
Else
Set ws_nw = Worksheets("Non-Weapons")
Set ws_w = Worksheets("Weapons")
End If
lz_w = ws_w.Cells(Rows.Count, 1).End(xlUp).Row
Anzahl = 5
DPS(1, 0) = 0
DPS(2, 0) = 0
DPS(3, 0) = 0
DPS(4, 0) = 0
DPS(5, 0) = 0
Speicheranzahl = 10001
Setbonus = 0
On Error Resume Next
For a = 2 To ws.Cells(21, 3).Value
For b = ws.Cells(21, 3).Value + 1 To ws.Cells(22, 3).Value
For c = ws.Cells(22, 3).Value + 1 To ws.Cells(23, 3).Value
For d = ws.Cells(23, 3).Value + 1 To ws.Cells(24, 3).Value
For e = ws.Cells(23, 3).Value + 1 To ws.Cells(24, 3).Value
For f = ws.Cells(24, 3).Value + 1 To ws.Cells(25, 3).Value
For g = ws.Cells(25, 3).Value + 1 To ws.Cells(26, 3).Value
For h = ws.Cells(27, 3).Value + 1 To ws.Cells(28, 3).Value
For i = ws.Cells(28, 3).Value + 1 To ws.Cells(29, 3).Value
For j = ws.Cells(30, 3).Value + 1 To ws.Cells(31, 3).Value
For k = ws.Cells(32, 3).Value + 1 To ws.Cells(33, 3).Value
For l = ws.Cells(33, 3).Value + 1 To ws.Cells(34, 3).Value
For o = ws.Cells(36, 2).Value To ws.Cells(35, 3).Value
For m = ws.Cells(35, 2).Value To ws.Cells(36, 2).Value - 1
If ws.Cells(m, 4).Value  "Two-Hand" Then
For n = ws.Cells(26, 3).Value + 1 To ws.Cells(27, 3).Value
If ws_l.Cells(a, 11).Value + ws_l.Cells(b, 11).Value + ws_l.Cells(c, 11).Value + _
ws_l.Cells(d, 11).Value + ws_l.Cells(e, 11).Value + ws_l.Cells(f, 11).Value + ws_l.Cells(g, 11).Value + ws_l.Cells(h, 11).Value + ws_l.Cells(i, 11).Value + ws_l.Cells(j, 11).Value + ws_l.Cells(k, 11).Value + ws_l.Cells(l, 11).Value + ws_l.Cells(m, 11).Value + ws_l.Cells(n, 11).Value + ws_l.Cells(o, 11).Value >= ws.Cells(4, 5).Value Then
If ws_l.Cells(a, 19).Value + ws_l.Cells(b, 19).Value + ws_l.Cells(c, 19).Value + _
ws_l.Cells(d, 19).Value + ws_l.Cells(e, 19).Value + ws_l.Cells(f, 19).Value + ws_l.Cells(g, 19).Value + ws_l.Cells(h, 19).Value + ws_l.Cells(i, 19).Value + ws_l.Cells(j, 19).Value + ws_l.Cells(k, 19).Value + ws_l.Cells(l, 19).Value + ws_l.Cells(m, 19).Value + ws_l.Cells(n, 19).Value + ws_l.Cells(o, 19).Value > DPS(4, 0) Then
DPS(Anzahl, 0) = ws_l.Cells(a, 19).Value + ws_l.Cells(b, 19).Value + ws_l. _
Cells(c, 19).Value + ws_l.Cells(d, 19).Value + ws_l.Cells(e, 19).Value + ws_l.Cells(f, 19).Value + ws_l.Cells(g, 19).Value + ws_l.Cells(h, 19).Value + ws_l.Cells(i, 19).Value + ws_l.Cells(j, 19).Value + ws_l.Cells(k, 19).Value + ws_l.Cells(l, 19).Value + ws_l.Cells(m, 19).Value + ws_l.Cells(n, 19).Value + ws_l.Cells(o, 19).Value
DPS(Anzahl, 1) = g
DPS(Anzahl, 2) = i
DPS(Anzahl, 3) = j
DPS(Anzahl, 4) = a
DPS(Anzahl, 5) = b
DPS(Anzahl, 6) = l
DPS(Anzahl, 7) = f
DPS(Anzahl, 8) = k
DPS(Anzahl, 9) = h
DPS(Anzahl, 10) = c
DPS(Anzahl, 11) = d
DPS(Anzahl, 12) = e
DPS(Anzahl, 13) = m
DPS(Anzahl, 14) = n
DPS(Anzahl, 15) = o
'Setbonus
If Left(ws_l.Cells(g, 2).Value, 3) = "Set" Then Setbonus = Setbonus + 1
If Left(ws_l.Cells(b, 2).Value, 3) = "Set" Then Setbonus = Setbonus + 1
If Left(ws_l.Cells(f, 2).Value, 3) = "Set" Then Setbonus = Setbonus + 1
If Left(ws_l.Cells(j, 2).Value, 3) = "Set" Then Setbonus = Setbonus + 1
If Left(ws_l.Cells(h, 2).Value, 3) = "Set" Then Setbonus = Setbonus + 1
If Setbonus >= 2 Then DPS(Anzahl, 0) = DPS(Anzahl, 0) + ws.Cells(5, 5).Value
If Setbonus >= 4 Then DPS(Anzahl, 0) = DPS(Anzahl, 0) + ws.Cells(6, 5).Value
Setbonus = 0
Anzahl = Anzahl + 1
'Ordnen
If Anzahl = Speicheranzahl Then
Do
Tausch = False
For p = 1 To Anzahl - 1
If DPS(p, 0) = ws.Cells(4, 5).Value Then
If ws_l.Cells(a, 19).Value + ws_l.Cells(b, 19).Value + ws_l.Cells(c, 19).Value +  _
ws_l.Cells(d, 19).Value + ws_l.Cells(e, 19).Value + ws_l.Cells(f, 19).Value + ws_l.Cells(g, 19).Value + ws_l.Cells(h, 19).Value + ws_l.Cells(i, 19).Value + ws_l.Cells(j, 19).Value + ws_l.Cells(k, 19).Value + ws_l.Cells(l, 19).Value + ws_l.Cells(m, 19).Value + ws_l.Cells(n, 19).Value + ws_l.Cells(o, 19).Value > DPS(4, 0) Then
DPS(Anzahl, 0) = ws_l.Cells(a, 19).Value + ws_l.Cells(b, 19).Value + ws_l.Cells( _
c, 19).Value + ws_l.Cells(d, 19).Value + ws_l.Cells(e, 19).Value + ws_l.Cells(f, 19).Value + ws_l.Cells(g, 19).Value + ws_l.Cells(h, 19).Value + ws_l.Cells(i, 19).Value + ws_l.Cells(j, 19).Value + ws_l.Cells(k, 19).Value + ws_l.Cells(l, 19).Value + ws_l.Cells(m, 19).Value + ws_l.Cells(o, 19).Value
DPS(Anzahl, 1) = g
DPS(Anzahl, 2) = i
DPS(Anzahl, 3) = j
DPS(Anzahl, 4) = a
DPS(Anzahl, 5) = b
DPS(Anzahl, 6) = l
DPS(Anzahl, 7) = f
DPS(Anzahl, 8) = k
DPS(Anzahl, 9) = h
DPS(Anzahl, 10) = c
DPS(Anzahl, 11) = d
DPS(Anzahl, 12) = e
DPS(Anzahl, 13) = m
DPS(Anzahl, 14) = 800
DPS(Anzahl, 15) = o
'Setbonus
If Left(ws_l.Cells(g, 2).Value, 3) = "Set" Then Setbonus = Setbonus + 1
If Left(ws_l.Cells(b, 2).Value, 3) = "Set" Then Setbonus = Setbonus + 1
If Left(ws_l.Cells(f, 2).Value, 3) = "Set" Then Setbonus = Setbonus + 1
If Left(ws_l.Cells(j, 2).Value, 3) = "Set" Then Setbonus = Setbonus + 1
If Left(ws_l.Cells(h, 2).Value, 3) = "Set" Then Setbonus = Setbonus + 1
If Setbonus >= 2 Then DPS(Anzahl, 0) = DPS(Anzahl, 0) + ws.Cells(5, 5).Value
If Setbonus >= 4 Then DPS(Anzahl, 0) = DPS(Anzahl, 0) + ws.Cells(6, 5).Value
Setbonus = 0
Anzahl = Anzahl + 1
'Ordnen
If Anzahl = Speicheranzahl Then
Do
Tausch = False
For p = 1 To Anzahl - 1
If DPS(p, 0)

Es gibt 15 Slots mit unterschiedlichen Möglichkeiten diese zu befüllen (Zwischen 5 und 20 Werten pro Slot). Ziel ist es alle Möglichkeiten zu vergleichen und die besten 4 auszugeben.in DPS(Anzahl, 0) wird der Vergleichswert gespeichert und in den restlichen Feldern des Arrays die Information dazu welche Zusammensetzung diesen Wert ergeben hat.
In Einzelschritten funktioniert es leider auch nicht er stürzt mir da genauso ab.
Anzeige
lade eine Beispieldatei...
18.12.2009 13:26:00
Tino
Hallo,
, ich möchte dies nicht nachbauen.
Frohe Festtage wünscht Tino
AW: lade eine Beispieldatei...
18.12.2009 14:39:39
Illusion
Das war der Grund wieso ich hoffte, das Problem mit dem kleinen Beispiel im Startpost beizulegen.
Vielen Dank, dass du trotzdem noch gewillt bist es dir anzuschauen :)
https://www.herber.de/bbs/user/66703.xlsm
sorry ich kann Dir nicht helfen...
18.12.2009 16:53:09
Tino
Hallo,
, wenn ich das On Error raus mache,
stoße ich ständig auf irgendwelche Fehler wo der Code stehen bleibt und ich kann so auf die Schnelle
die Fehler auch nicht lokalisieren.
Ich lass die Frage mal offen, vielleicht hat einer die Zeit und die Lust sich damit zu beschäftigen.
Sorry und noch schöne Feiertage.
Gruß Tino
Anzeige
AW: sorry ich kann Dir nicht helfen...
18.12.2009 18:04:14
BoskoBiati
Hallo,
ich denke, als xlsm werden sich nicht so viele dran machen.
Gruß
Bosko
AW: sorry ich kann Dir nicht helfen...
18.12.2009 18:20:19
Illusion
Schade trotzdem danke für die Hilfe soweit Tino.
@BoskoBiati Aha. Wieso nicht und als was sollte ich es sonst speichern und hochladen? Soll nicht an am Dateityp scheitern *g*
AW: sorry ich kann Dir nicht helfen...
19.12.2009 08:06:59
BoskoBiati
Hallo,
speichere es als xls (Office 2003)
Gruß
Bosko
AW: sorry ich kann Dir nicht helfen...
20.12.2009 20:22:01
Illusion
Habe jetzt mal versucht die Anzahl der Möglichkeiten in der Liste die gegenverglichen werden zu verringern und damit läuft es und ich bekomm eine Ausgabe. Der Fehler scheint also nicht im Code zu liegen sondern, dass Excel mit der Menge einfach nicht klarkommt, was ich aber insofern nicht verstehe, weil im Array wird ja immer nur die gleiche Menge abgespeichert die Excel auch schafft. Also das wird nicht größer und ansonsten geht es immer nur um die Abarbeitung von Arbeitsschritten wo aber keine extra Zwischenspeicherung erfolgt, und da Excel doch nicht sehen sollte wieviel noch abzuarbeiten ist, verstehe ich den Grund wieso es zusammenbricht nicht. Das es lange dauert ok, aber da es ein paar Durchgänge schafft bevor es abstürzt kann ich irgendwie nicht nachvollziehen.
Anzeige

301 Forumthreads zu ähnlichen Themen

Zeichenkette per for-next-schleife erstellen
lauer

Hallo,
ich möchte mir eine Zeichenkette erstellen lassen.
Ich habe in einer Zelle (B11) den Anfang (1) angegeben und in der anderen (C11) steht das Ende (49).
Nun möchte ich, dass er mir in der E11 die Zeichenkette reinschreibt.
Also ich möchte dann in E11 stehen haben: 1,2,3,4,...
09.08.2008 19:06:00
Thread-ID: 1000538
5 Beiträge
Anzeige
For Next Schleife - Performance
Christoph

Hallo VBA-Experten!
Bin im VBA-Sektor erst seit 3 Tagen aktiv (Selbsteinschulung :-) ). Habe jetzt aber leider ein rießiges Problem und bitte ganz dringend um Eure Hilfe:
In meinem Bericht (siehe Anhang - https://www.herber.de/bbs/user/62579.zip)
soll folgendes passieren:
Der Be...
19.06.2009 17:54:19
Thread-ID: 1082980
6 Beiträge
Array füllen ohne For...Next-Schleife
Micha

Hallo,
ich möchte einen Array-füllen, ohne eine Schleife benutzen zu müssen, um Zeit zu sparen, d.h. anstatt
For CalcArraycnt = 1 To 30
CalcArray(cnt, CalcArraycnt) = "=PRODUCT(R[-2]C,R[-1]C)"
Next
irgendwas wie
Range(CalcArray(cnt, 1),CalcArray(cnt, 30) = "=PRODUCT(R[...
13.10.2009 12:21:38
Thread-ID: 1109304
6 Beiträge
Anzeige
Sytanx zur ForNext-Schleife
Jörg-HH

Guten Abend zusammen,
habe einen Knoten mit der richtigen Schreibweise...
In einem Blattcode steht:
If Target.Address = Range("Hilfszelle2").Address Then Call machwas2 End If If Target.Address = Range("Hilfszelle3").Address Then Call machwas3 End If usw... bis 5
in einem Modul...
08.12.2009 20:44:25
Thread-ID: 1122490
11 Beiträge
For...Next Schleife anstelle Do until...Loop | Herbers Excel-Forum
Stefan
Hallo zusammen,
ich habe eine Do...Loop Schleife und würde diese gerne durch eine For...Next Schleife ersetzten.
Geht das in diesem Fall überhaupt? Sub loop() Dim iRow As Integer iRow = 5 Do Until Cells(iRow - 1, 1).Value = "x" If IsEmpty(Cells(iRow, 1)) Then End If iRow = iRow + 1 Loop End...
14.01.2010 15:23:09
Thread-ID: 1129973
11 Beiträge
For Next Schleife ?
Leitz

Hallo!
Wie kann ich eine For Next Schleife so ändern, daß sie aufhört sobald die erste Übereinstimmung gefunden wurde?
Oder muß ich da was anders vewenden?
Sub DatumSuche() Dim Datum As Date Datum = Cells(3, 5) 'Testdatum Dim a As Integer For a = 100 To 3 Step -1 If Cells(a, 1).Text...
09.02.2010 18:48:49
Thread-ID: 1137145
13 Beiträge
dynamische For Next Schleife
Steffen

Hallo zusammen,
ich habe eine For next Schleife, der obere Bereich soll hier bei dynamisch sein, da während der Prozedur Zeilen eingefügt werden. Ich habe es mit folgendem Code probiert wobei der obere Bereich auch hochgezählt wird aber die Schleife bei dem Ursprungswert beendet wird.
D...
19.02.2010 12:24:57
Thread-ID: 1139740
6 Beiträge
For Next Schleife umschreiben
Alex

Hallo zusammen,
ich habe hier eine ForNext-Schleife, die ich so nicht lassen kann.
Wenn die Bedingung nicht erfüllt ist soll ein Parameter gesetzt werden.
Wenn die Bedingung erfüllt ist , wird eine Abfrage gemacht, ob die Datei überschrieben werden soll. Wird diese Abfrage n...
06.05.2010 13:15:30
Thread-ID: 1155800
9 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
4
1
5
5
6
10
10
12
5
8
4
6
6
19
6
9
8
16
10
3
7
1
4
7
2