AW: Löschen - Suchbegriff finden
20.11.2008 08:41:02
Frank
Hallo Zusammen!
Ich schlafe noch!!!
Ihr braucht ja sicherlich den Code!!!
Private Sub CommandButton3_Click()
Dim lng As Long
Dim i As Integer
Application.ScreenUpdating = False
With frmDaten_Januar
.ListBox1.Clear
Sheets("Januar").Activate
i = 0
For lng = 5 To ActiveSheet.UsedRange.Rows.Count
If InStr(LCase(Cells(lng, 30).Value), LCase(.TextBox1.Value)) > 0 Then
.ListBox1.AddItem Cells(lng, 1).Text
.ListBox1.Column(1, i) = Cells(lng, 31).Text
.ListBox1.Column(2, i) = Cells(lng, 33).Text
.ListBox1.Column(3, i) = Cells(lng, 34).Text
.ListBox1.Column(4, i) = Cells(lng, 35).Text
.ListBox1.Column(5, i) = Cells(lng, 36).Text
.ListBox1.Column(6, i) = Cells(lng, 37).Text
.ListBox1.Column(7, i) = Cells(lng, 38).Row
i = i + 1
Else
End If
Next lng
End With
frmDaten_Januar.Label9.Caption = frmDaten_Januar.Label1.Caption
frmDaten_Januar.Label10.Caption = frmDaten_Januar.Label2.Caption
frmDaten_Januar.Label11.Caption = frmDaten_Januar.Label3.Caption
frmDaten_Januar.Label12.Caption = frmDaten_Januar.Label4.Caption
frmDaten_Januar.Label13.Caption = frmDaten_Januar.Label6.Caption
frmDaten_Januar.Label14.Caption = frmDaten_Januar.Label7.Caption
frmDaten_Januar.Label15.Caption = frmDaten_Januar.Label8.Caption
frmDaten_Januar.Label16.Caption = frmDaten_Januar.Label7.Caption
frmDaten_Januar.Label17.Caption = frmDaten_Januar.Label8.Caption
frmDaten_Januar.Label32.Caption = frmDaten_Januar.Label31.Caption
frmDaten_Januar.Label33.Caption = frmDaten_Januar.Label31.Caption
Application.ScreenUpdating = True
Dim zelle As Range
Dim sBegriff As String
sBegriff = TextBox1.Value
If sBegriff = "" Then Exit Sub
Set zelle = Worksheets("Januar").Columns(30) _
.Find(sBegriff, LookAt:=xlWhole)
If zelle Is Nothing Then
MsgBox "Suchbegriff wurde nicht gefunden!"
Else
zelle.Offset(0, 1).Select
Selection.ClearContents
zelle.Offset(0, 2).Select
Selection.ClearContents
zelle.Offset(0, 4).Select
Selection.ClearContents
zelle.Offset(0, 5).Select
Selection.ClearContents
zelle.Offset(0, 6).Select
Selection.ClearContents
zelle.Offset(0, 7).Select
Selection.ClearContents
zelle.Offset(0, 8).Select
Selection.ClearContents
End If
Unload Me
End Sub
Gruß Frank H.