Hallo judoka,
der folgende VBA-Code funktioniert in Verbindung mit einer UserForm:
Option Explicit
Dim bDoSearchProcess As Boolean
Dim bNotInsertItem As Boolean
Private Sub cmdCancel_Click()
bNotInsertItem = True
VBA.DoEvents
Unload Me
End Sub
Private Sub cmdOK_Click()
If Not bDoSearchProcess Then
DoSearchProcess
Else
bDoSearchProcess = False
End If
End Sub
Sub DoSearchProcess()
’ Liest einen zufälligen Eintrag aus der Namensliste heraus
’ der noch nicht in der Ausgabeliste enthalten ist
’ Die Augabeliste ist immer in der aktuellen Tabelle in der Spalte A
Dim rngNM As Range
Dim rngOut As Range
Dim rngFound As Range
Dim sName As String
Dim lRowOut As Long
Dim lCnt As Long
Dim sLabelCMDOK As String, sLabelCMDCancel As String, sProcCaption As String
Dim lTimer As Long
Set rngNM = ActiveWorkbook.Names(„Namensliste“).RefersToRange
sLabelCMDOK = Me.cmdOK.Caption
sLabelCMDCancel = Me.cmdCancel.Caption
Me.cmdCancel.Caption = „Abbrechen“
bDoSearchProcess = True
’ Verwendeten Bereich ermitteln
Set rngOut = ActiveSheet.UsedRange
Me.Repaint
Do
lTimer = Timer
Do
sName = rngNM.Cells((Rnd(1) * rngNM.Rows.Count - 1) + 1, 1).Text
Set rngFound = rngOut.Find(sName)
If Abs(lTimer - Timer) >= 1 Then
sProcCaption = "Suche " & String(Timer * 10 Mod 7, „.“)
If Not Me.cmdOK.Caption = sProcCaption Then
Me.cmdOK.Caption = sProcCaption
Me.Repaint
End If
End If
VBA.DoEvents
Loop While Not rngFound Is Nothing And Not bNotInsertItem
lCnt = lCnt + 1
Me.lblSearchProcess.Caption = IIf(rngFound Is Nothing, sName, „–“)
Me.cmdOK.Caption = "Übernehmen - " & Format(lCnt, „#,##0“)
Me.Repaint
Loop While bDoSearchProcess And Not bNotInsertItem
If rngFound Is Nothing And Not bNotInsertItem Then
lRowOut = rngOut.Rows.Count
While rngOut.Cells(lRowOut, 1).Text „“
lRowOut = lRowOut + 1
Wend
rngOut.Cells(lRowOut, 1).Formula = sName
End If
bDoSearchProcess = False
Me.cmdOK.Caption = sLabelCMDOK
Me.cmdCancel.Caption = sLabelCMDCancel
End Sub
Private Sub UserForm_Terminate()
bNotInsertItem = True
VBA.DoEvents
End Sub
Damit das VBA-Programm fehlerfrei funktioniert, müssen folgende Voraussetzungen erfüllt sein:
- Benannter Bereich „Namensliste“ mit allen vorhandenen Namen
- Eine UserForm mit einer label-Control „lblSearchProcess“ und zwei CommandButton-Objekte: „cmdOK“ und „cmdCancel“
Der CommandButton „cmdOK“ sollte mit dem Caption „Start“ beschriftet werden
Der CommandButton „cmdCancel“ bricht den Suchvorgang ab und schließt die UserForm.
Eine Beispiel-Excel-Datei kann gerne via eMail zugesandt werden.
Hinweis: Das VBA-Programm wurde unter Excel 2000 erstellt. Nach meinen Kenntnissen dürften keine Fehler in Excel 2010 auftreten.
Viele Grüße,
BigBen
