Schleife mit Button abbrechen VBA
24.07.2005 17:01:27
Wolfgang
mit folgendem Makro werden Zufallszahlen (ug=Untergrenze, og=Obergrenze) im festgelegten Bereich der Spalte A (zeist=Zeilenstart, zeizi=Zeilenziel) erzeugt. Klappt auch.
Wenn ich bei doppelten Zahlen eine Neuberechnung durchführen lasse (nochmal:) dauert es bei sehr großen Zahlen sehr lange, das Löschen der doppelten Zahlen möchte ich vermeiden. Ich habe schon vorgegeben, daß die Zufallszahlen 3 x größer als die Zeilenanzahl sind, hilft aber nur bei kleineren Zahlen.
Ich habe deshalb versucht einen Abbruch-Button zu setzen, der die Schleife abbrechen soll. Leider reichen meine VBA-Bastelkenntnisse nicht aus z.B. den gefundenen Code: bAbort = False / Do / mein Makro / DoEvents / Loop Until bAbort = True in das Makro zu integrieren.
Den Abbruch mittels Esc / Strg Unterb möchte ich umgehen, da der VBA-Editor nicht geöffnet werden soll.
Würde mich sehr freuen, wenn mir geholfen werden kann.
Schönen Tag wünscht Wolfgang
Option Explicit
Private bAbort As Boolean
Private Sub CommandButton1_Click()
Dim zuf, og, ug As Double
Dim zeist, zeizi, spst, spzi, s, t, Zaehler, Zeile As Integer
On Error Resume Next
ug = Me.TextBox1.Value
og = Me.TextBox2.Value
zeist = Range((Me.TextBox3)).Row
zeizi = Range(Me.TextBox4).Row
spst = Range((Me.TextBox3)).Column
spzi = Range(Me.TextBox4).Column
If CheckBox2 = True Then
Range("A:A").Clear
End If
nochmal:
For s = zeist To zeizi
For t = spst To spzi
zuf = Int((og - ug + 1) * Rnd + ug)
Cells(s, t).NumberFormat = "0"
Cells(s, t) = zuf
Next t
Next s
If CheckBox2 = True Then
If og - ug < (zeizi - zeist) * 3 Then
MsgBox "Es müssen die Daten verändert werden,"
Exit Sub
End If
Zeile = Cells(Cells.Rows.Count, 1).End(xlUp).Row
For Zaehler = Zeile To 1 Step -1
If WorksheetFunction.CountIf(Columns(1), Cells(Zaehler, 1)) > 1 Then GoTo nochmal
Next Zaehler
End If
End Sub
Private Sub cmdAbort_Click()
bAbort = True
End Sub
Private Sub CommandButton2_Click()
UserForm1.Hide
End Sub
Private Sub CommandButton3_Click()
On Error Resume Next
Range(Me.TextBox3.Text, Me.TextBox4.Text).Clear
End Sub
Anzeige