Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VB Makro hängt sich auf bei großen Datenmengen
#1
Hallo Leute,

ich habe ein kleines Problem mit einem VB Makro.

Vorab zur Problemstellung, welche das Makro lösen soll:

Es existieren Tabellen mit mehreren Datensätzen. Z.B. 10 Spalten auf 2500 Zeilen. Eine Spalte (im folgenden Beispiel die 7. Spalte) enthält einen Zahlenwert.
Sobald dieser Zahlenwert von 1 abweicht soll die entsprechende Zelle den Wert 1 erhalten und danach die Zeile um die Häufigkeit des Wertes darunter kopiert werden.

D.h. z.B. haben wir folgende Tabelle (Zielwert fett markiert):

Wert A - Wert B - Wert C - Wert D - Wert E - Wert F - 2 - Wert G - Wert H - Wert I
Wert X - Wert K - Wert L - Wert M - Wert N - Wert O - 1 - Wert P - Wert Q - Wert R
Wert 1 - Wert 2 - Wert 3 - Wert 4 - Wert 5 - Wert 6 - 3 - Wert 8 - Wert 9 - Wert 10


Soll daraus folgende Tabelle generiert werden:

Wert A - Wert B - Wert C - Wert D - Wert E - Wert F - 1 - Wert G - Wert H - Wert I
Wert A - Wert B - Wert C - Wert D - Wert E - Wert F - 1 - Wert G - Wert H - Wert I
Wert X - Wert K - Wert L - Wert M - Wert N - Wert O - 1 - Wert P - Wert Q - Wert R
Wert 1 - Wert 2 - Wert 3 - Wert 4 - Wert 5 - Wert 6 - 1 - Wert 8 - Wert 9 - Wert 10
Wert 1 - Wert 2 - Wert 3 - Wert 4 - Wert 5 - Wert 6 - 1 - Wert 8 - Wert 9 - Wert 10
Wert 1 - Wert 2 - Wert 3 - Wert 4 - Wert 5 - Wert 6 - 1 - Wert 8 - Wert 9 - Wert 10


Die Anzahl der Datensätze und die Höhe und Häufigkeit des Zahlenwertes der das Zellenkopieren bei Abweichung von 1 auslöst sind variabel. Dazu habe ich folgendes Makro erstellt und auch in einer kleinen Tabelle mit 200 Datensätzen erfolgreich getestet.

Setze ich das Makro nun bei der Zieltabelle ein die rund 3000 Zeilen und einige Zellen mit einem Zielwert > 1 beinhaltet (bis 200), hängt sich Excel nach etwa 5-10 Sekunden auf.  Ich habe es auch schon laufen lassen und gehofft, dass trotz "keiner Rückmeldung" die Rechnung weiter geht - dem war aber leider nicht so.

Habe ich etwas bei dem Makro falsch gemacht oder gibt es eine andere Möglichkeit das Problem zu lösen damit sich Excel nicht mehr aufhängt?

Hier das Makro:

Code:
Sub Zeileneinfuegen()

   Dim LastRow As Long
   With ActiveSheet
       LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   End With


Dim i     As Integer
Dim zw    As Integer
Dim zwi    As Integer


For i = LastRow To 1 Step -1
 If Cells(i, 7).Value <> "1" Then
    zw = Cells(i, 7).Value
    Cells(i, 7).Value = "1"
   
 For zwi = 2 To zw
    Rows(i).Copy
    Rows(i + 1).Insert Shift:=xlDown
    Next zwi

     
 End If
Next i

End Sub


Ich Danke euch vielmals vorab.
Antworten Top
#2
Hallo,

so vielleicht:

Code:
Sub Zeileneinfuegen()
 Dim i As Long
 Dim LastRow As Long
 
 With ActiveSheet
     LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
 End With

 For i = LastRow To 1 Step -1
   If IsNumeric(Cells(i, 7).Value) Then
     If Cells(i, 7).Value > 1 Then
       Rows(i).Copy
       Rows(i).Resize(Cells(i, 7).Value - 1).Insert
     End If
   End If
 Next i
End Sub

Gruß Uwe
Antworten Top
#3
Hallo Bjoux,
vielleicht lässt sich Dein Problem mit
application.screenupdating=false'vor for i=...
und
application.screenupdating=true'nach next i
lösen, dann hat Excel nicht so viel zu tun...
Bei mir ging es mit 3000 Zeilen (und einer kleinen Pause) eigentlich gut.
Gruß der AlteDresdner
Gruß der AlteDresdner (Win11, Off2021)
Antworten Top
#4
Hallo,

hier noch eine Arrayvariante:

Code:
Sub Zeileneinfuegen()
 Dim lngZeileQ As Long, lngZeileZ As Long, lngSpalte As Long
 Dim varQ As Variant, varZ As Variant
 lngZeileZ = 1
 varQ = Cells(1, 1).CurrentRegion.Value
 ReDim varZ(1 To Application.CountA(Columns(7)) - Application.Count(Columns(7)) + Application.Sum(Columns(7)), 1 To UBound(varQ, 2))
 For lngZeileQ = 1 To UBound(varQ, 1)
   If IsNumeric(varQ(lngZeileQ, 7)) Then
     For lngZeileZ = lngZeileZ To lngZeileZ + varQ(lngZeileQ, 7) - 1
       For lngSpalte = 1 To UBound(varQ, 2)
         varZ(lngZeileZ, lngSpalte) = varQ(lngZeileQ, lngSpalte)
       Next lngSpalte
       varZ(lngZeileZ, 7) = 1
     Next lngZeileZ
   Else
     For lngSpalte = 1 To UBound(varQ, 2)
       varZ(lngZeileZ, lngSpalte) = varQ(lngZeileQ, lngSpalte)
     Next lngSpalte
     lngZeileZ = lngZeileZ + 1
   End If
 Next lngZeileQ
 Cells(1, 1).Resize(UBound(varZ, 1), UBound(varZ, 2)).Value = varZ
End Sub

Gruß Uwe
Antworten Top
#5
Vielen Dank für Eure Hilfe.

Eine Mischung aus den ersten beiden hat nun zum Erfolg geführt.

Excel wirkt zwar als ob es sich aufhinge, wenn man jedoch 1-2 Minuten wartet, sind die Resultate auch bei großen Datenmengen korrekt.

Herzlichsten Dank!
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste