21.11.2019, 07:15
Die Informationen befinden sich rechts davon in den 2 nanebenliegenden Zellen. Also kann ich die ganze Zeile löschen und nach oben verschieben hat auch gut geklappt. Danke dir :)
Option Explicit Private Sub CommandButton1_Click() Dim oWkSh As Worksheet Dim rngF As Range Dim strF As String Set oWkSh = ThisWorkbook.Worksheets("Datenbank_TN") If TextBox1.Value <> "" Then Set rngF = oWkSh.Columns(1).Find(TextBox1.Value, , xlValues, xlWhole) If Not rngF Is Nothing Then strF = rngF.Address With ListBox1 .Clear .BoundColumn = 1 .ColumnCount = 4 .ColumnWidths = 0 'erste Spalte wird ausgeblendet .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption Do .AddItem rngF.Resize(, 3).Address(External:=True) .List(.ListCount - 1, 1) = rngF.Value .List(.ListCount - 1, 2) = rngF.Offset(, 1).Value .List(.ListCount - 1, 3) = rngF.Offset(, 2).Value Set rngF = oWkSh.Columns(1).FindNext(rngF) Loop While Not rngF Is Nothing And rngF.Address <> strF End With Else With TextBox1 MsgBox "Der gesuchte Begriff """ & .Value & _ """ wurde nicht gefunden.", _ 48, " Hinweis für " & Application.UserName .SetFocus .SelStart = 0 .SelLength = Len(.Value) End With End If Else MsgBox "Sie müssen einen Suchbegriff eingeben - danke.", _ 48, " Hinweis für " & Application.UserName TextBox1.SetFocus End If End Sub Private Sub CommandButton2_Click() Dim i As Long Dim rngZ As Range With ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) Then If Not rngZ Is Nothing Then Set rngZ = Application.Union(rngZ, Range(.List(i, 0))) Else Set rngZ = Range(.List(i, 0)) End If End If Next i End With If Not rngZ Is Nothing Then Application.Goto rngZ End If End SubVBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0
Typ | Name | Eigenschaften | ||||||||||||
CommandButton | CommandButton1 |
| ||||||||||||
CommandButton | CommandButton2 |
| ||||||||||||
ListBox | ListBox1 |
| ||||||||||||
TextBox | TextBox1 |
|
Option Explicit Sub Schaltfläche1_Klicken() UserForm1.Show End SubGruß UweVBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0