Ich habe einen Code zusammengebaut welcher in einer Spalte nach einem Suchbergriff sucht. Dies funktioniert alles wie gewünscht. Nun möchte ich noch, dass es mir in einer MsgBox die Anzahl der gefundenen Zeilen ausgibt. Wie und wo muss ich das einbauen?
Besten Dank und einen schönen Abend.
Gruss Daniel
Private Sub CommandButton1_Click()
Dim i%, strAusgabe$
Dim Suchen As String
Dim ws As Worksheet
Dim LetzteZeile, LetzteSpalte As Integer
Dim sFirstAdress As String
Dim rng As Range
Set ws = Worksheets("Lagerliste_drucken")
With ListBox1
If .Selected(i) = False Then
MsgBox "Bitte Lagerort(e) auswählen!", vbInformation
Exit Sub
Else
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
Suchen = strAusgabe & .List(i)
Set rng = Worksheets("WSCAR_Daten").Range("F:F").Find(Suchen, _
LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)
If rng Is Nothing Then
MsgBox "Lagerort " & Suchen & " nicht gefunden!", vbInformation
Else
If ws.Cells(1, 1) = "" Then
ws.Cells(1, 1) = "Lagerort " & Suchen
ws.Cells(1, 1).Borders.LineStyle = xlContinuous
ws.Cells(1, 1).Font.Bold = True
ws.Cells(2, 1) = "Vorname": ws.Cells(2, 2) = "Name": ws.Cells(2, 3) = "Marke"
ws.Cells(2, 4) = "Typ": ws.Cells(2, 5) = "Kontrollschild"
ws.Range(ws.Cells(2, 1), ws.Cells(2, 5)).Font.Bold = True
ws.Range(ws.Cells(2, 1), ws.Cells(2, 5)).Borders.LineStyle = xlContinuous
ws.Cells(1, 1).MergeArea.BorderAround xlContinuous, xlMedium, xlColorIndexAutomatic
Else
LetzteZeile = ws.Cells(Rows.Count, 1).End(xlUp).Row
LetzteSpalte = ws.Cells(LetzteZeile, Columns.Count).End(xlToLeft).Column
ws.Cells(LetzteZeile + 2, 1) = "Lagerort " & Suchen
ws.Cells(LetzteZeile + 2, 1).Font.Bold = True
ws.Cells(LetzteZeile + 3, 1) = "Vorname": ws.Cells(LetzteZeile + 3, 2) = "Name": ws.Cells(LetzteZeile + 3, 3) = "Marke"
ws.Cells(LetzteZeile + 3, 4) = "Typ": ws.Cells(LetzteZeile + 3, 5) = "Kontrollschild"
ws.Range(ws.Cells(LetzteZeile + 3, 1), ws.Cells(LetzteZeile + 3, 5)).Font.Bold = True
ws.Range(ws.Cells(LetzteZeile + 3, 1), ws.Cells(LetzteZeile + 3, 5)).Borders.LineStyle = xlContinuous
ws.Cells(LetzteZeile + 2, 1).MergeArea.BorderAround xlContinuous, xlMedium, xlColorIndexAutomatic
End If
sfirstaddress = rng.Address
Do
rng.Offset(0, -5).Resize(1, 5).Copy Destination:=Worksheets("Lagerliste_Drucken").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Set rng = Worksheets("WSCAR_Daten").Range("F:F").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address sfirstaddress
End If
Else
End If
Next
End If
End With
End Sub