23.06.2016, 18:32
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:
Ich Danke euch vielmals vorab.
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.