Hi Axel
Option Explicit
Private Sub CommandButton1_Click()
Dim iZeile As Long, iAnzahl As Long
If ListBox1.ListIndex = -1 Then
MsgBox "Es wurde keine Auswahl getroffen."
Exit Sub
End If
For iZeile = 1 To Range("A65536").End(xlUp).Row
If Cells(iZeile, 1) = "x" Then iAnzahl = iAnzahl + 1
If iAnzahl = ListBox1.ListIndex + 1 Then Exit For
Next iZeile
Cells(iZeile, 1) = ""
ListBox1.RemoveItem (ListBox1.ListIndex)
End Sub
Private Sub UserForm_Initialize()
Call suchen
End Sub
Und dann habe ich leider noch ein kleiner Fehler im anderen Makro gefunden (letzte Zeile Application.ScreenUpdating = True)... Sorry wird langsam peinlich
Option Explicit
Sub suchen()
Dim i As Integer
Dim lngArr As Integer
Dim SuchZelle As String
Application.ScreenUpdating = False
SuchZelle = "x"
With Worksheets("Tabelle1")
lngArr = Application.WorksheetFunction.CountIf(.Range("A1:A200"), SuchZelle)
If lngArr = 0 Then
MsgBox "Keine Einträge gemäss den ausgewählten Kriterien"
Exit Sub
End If
ReDim MyArray(1 To lngArr, 0 To 4)
lngArr = 0
For i = 1 To 200
If .Cells(i, 1) = SuchZelle Then
lngArr = lngArr + 1
MyArray(lngArr, 0) = .Cells(i, 2)
MyArray(lngArr, 1) = .Cells(i, 3)
MyArray(lngArr, 2) = .Cells(i, 4)
MyArray(lngArr, 3) = .Cells(i, 5)
MyArray(lngArr, 4) = .Cells(i, 6)
End If
Next i
UserForm1.ListBox1.ColumnCount = 5
UserForm1.ListBox1.List = MyArray
End With
Application.ScreenUpdating = True
End Sub
Gruss
Chris