Microsoft Excel

Herbers Excel/VBA-Archiv

Verschachtelte For Next Schleife zusammenfassen | Herbers Excel-Forum


Betrifft: Verschachtelte For Next Schleife zusammenfassen von: Illusion
Geschrieben am: 17.12.2009 12:47:34

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

  

Betrifft: AW: Verschachtelte For Next Schleife zusammenfassen von: Tino
Geschrieben am: 17.12.2009 12:55:13

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


  

Betrifft: AW: Verschachtelte For Next Schleife zusammenfassen von: Illusion
Geschrieben am: 18.12.2009 10:45:03

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?


  

Betrifft: wie soll man helfen wenn... von: Tino
Geschrieben am: 18.12.2009 11:17:32

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 TinoSmilies


  

Betrifft: läuft es durch, bei Einzelschritten (F8)? oT von: Björn B.
Geschrieben am: 18.12.2009 11:46:05




  

Betrifft: AW: wie soll man helfen wenn... von: Illusion
Geschrieben am: 18.12.2009 12:37:17

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) < DPS(p + 1, 0) Then
                     For q = 0 To 15
                      DPS(Anzahl, q) = DPS(p, q)
                      DPS(p, q) = DPS(p + 1, q)
                      DPS(p + 1, q) = DPS(Anzahl, q)
                      Tausch = True
                     Next q
                    End If
                   Next p
                  Loop While Tausch = True
                  Anzahl = 5
                 End If
                End If
               End If
              Next n
             Else
              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(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) < DPS(p + 1, 0) Then
                     For q = 0 To 15
                      DPS(Anzahl, q) = DPS(p, q)
                      DPS(p, q) = DPS(p + 1, q)
                      DPS(p + 1, q) = DPS(Anzahl, q)
                      Tausch = True
                     Next q
                    End If
                   Next p
                  Loop While Tausch = True
                  Anzahl = 5
                 End If
                End If
               End If
              End If
             Next m
            Next o
           Next l
          Next k
         Next j
        Next i
       Next h
      Next g
     Next f
    Next e
   Next d
  Next c
 Next b
Next a

End Sub

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.


  

Betrifft: lade eine Beispieldatei... von: Tino
Geschrieben am: 18.12.2009 13:26:00

Hallo,
, ich möchte dies nicht nachbauen.

Frohe Festtage wünscht TinoSmilies


  

Betrifft: AW: lade eine Beispieldatei... von: Illusion
Geschrieben am: 18.12.2009 14:39:39

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


  

Betrifft: sorry ich kann Dir nicht helfen... von: Tino
Geschrieben am: 18.12.2009 16:53:09

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


  

Betrifft: AW: sorry ich kann Dir nicht helfen... von: BoskoBiati
Geschrieben am: 18.12.2009 18:04:14

Hallo,

ich denke, als xlsm werden sich nicht so viele dran machen.

Gruß

Bosko


  

Betrifft: AW: sorry ich kann Dir nicht helfen... von: Illusion
Geschrieben am: 18.12.2009 18:20:19

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*


  

Betrifft: AW: sorry ich kann Dir nicht helfen... von: BoskoBiati
Geschrieben am: 19.12.2009 08:06:59

Hallo,

speichere es als xls (Office 2003)

Gruß

Bosko


  

Betrifft: AW: sorry ich kann Dir nicht helfen... von: Illusion
Geschrieben am: 19.12.2009 09:24:13

Ah ok. Erledigt:

https://www.herber.de/bbs/user/66708.zip

Thx für den Hinweis ^^


  

Betrifft: AW: sorry ich kann Dir nicht helfen... von: Illusion
Geschrieben am: 20.12.2009 20:22:01

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.


Beiträge aus den Excel-Beispielen zum Thema "Verschachtelte For Next Schleife zusammenfassen"