vba Suche auch bei Text mit Leerzeichen?

Dim rngCell As Range Dim strFirstAddress As String Dim rngBereich As Range Set rngBereich = Sheets("Tabelle1").Range("a2:G" & Sheets("Tabelle1").Cells(Rows.Count, _ 2).End( _ xlUp).Row) With rngBereich Me.ListBox1.Clear Set rngCell = .Find(Me.TextBox1.Value, LookIn:=xlValues, lookat:=xlWhole) If Not rngCell Is Nothing Then strFirstAddress = rngCell.Address Do With Me.ListBox1 .ColumnCount = 8 .AddItem .List(.ListCount - 1, 0) = Cells(rngCell.Row, 1) .List(.ListCount - 1, 1) = Cells(rngCell.Row, 2) .List(.ListCount - 1, 2) = Cells(rngCell.Row, 3) .List(.ListCount - 1, 3) = Cells(rngCell.Row, 4) .List(.ListCount - 1, 4) = Cells(rngCell.Row, 5) .List(.ListCount - 1, 5) = Cells(rngCell.Row, 6) .List(.ListCount - 1, 6) = Cells(rngCell.Row, 7) .List(.ListCount - 1, 7) = Cells(rngCell.Row, 8) .ColumnWidths = "1cm;2,5cm;2,5cm;1,5cm;6cm;2cm;3cm;0,5cm" End With Set rngCell = .FindNext(rngCell) Loop While Not rngCell Is Nothing And rngCell.Address strFirstAddress Else

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim Zeile As Long Dim Spalte As Long Application.ScreenUpdating = False With Me.ListBox1 Zeile = .List(.ListIndex, 9) Spalte = .List(.ListIndex, 8) Cells(Zeile, Spalte).Select End With Application.ScreenUpdating = True End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim rngCell As Range Dim strFirstAddress As String Dim rngBereich As Range If Target.Address = "$B$1" Then 'Zelle an deine Bedürfnisse anpassen If Target = "" Then Me.ListBox1.Clear Exit Sub End If Set rngBereich = Sheets("Tabelle1").Range("A2:G" & Sheets("Tabelle1").Cells(Rows.Count, _ 2).End(xlUp).Row) With rngBereich Me.ListBox1.Clear Set rngCell = .Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole) If Not rngCell Is Nothing Then strFirstAddress = rngCell.Address Do With Me.ListBox1 .ColumnCount = 10 .AddItem .List(.ListCount - 1, 0) = Cells(rngCell.Row, 1) .List(.ListCount - 1, 1) = Cells(rngCell.Row, 2) .List(.ListCount - 1, 2) = Cells(rngCell.Row, 3) .List(.ListCount - 1, 3) = Cells(rngCell.Row, 4) .List(.ListCount - 1, 4) = Cells(rngCell.Row, 5) .List(.ListCount - 1, 5) = Cells(rngCell.Row, 6) .List(.ListCount - 1, 6) = Cells(rngCell.Row, 7) .List(.ListCount - 1, 7) = Cells(rngCell.Row, 8) .List(.ListCount - 1, 8) = rngCell.Column .List(.ListCount - 1, 9) = rngCell.Row .ColumnWidths = "2cm;2,5cm;2,5cm;1,5cm;6cm;2cm;3cm;0,5cm;0cm;0cm" End With Set rngCell = .FindNext(rngCell) Loop While Not rngCell Is Nothing And rngCell.Address strFirstAddress End If End With End If End Sub

Hallo Werner,
darf ich nocheinmal um Hilfe bitten?
Die von Dir liebenswürdiger Weise angepasste Tabelle hat im Sucherverhalten zur ersten einen Unterschied.
Ich rauf mir hier die Haare, aber ich find die Stelle im Code nicht die das auslöst.
Mit der ersten Tabelle konnte man egal in welcher Spalte suchen. Jeder Suchbegriff der Range wurde gefunden und die entsprechende Zeile dazu aufgelistet.
Mit der an zwei Bedingungen angepassten Tabelle wird nur noch in Spalte "D" und "F" gesucht.
Im Grunde so, wie ich das mit der bedingten Formatierung simuliert hatte...
Schöner wäre freilich wenn er weiterhin in allen Spalten suchen würde.
Könntest du mir hier nochmal unter die Arme greifen?
Ich hatte auch versucht, die Listbox auf ein anderes Tabellenblatt zu bringen.
Trotz meines Versuchs die Tabelle im Code entsprechend umzubenennen - das scheitert.
Wo ich auch erst nicht dahinter gestiegen bin - warum in meiner eigentlichen Datei der Ablauf des Codes immer die Listbox verkleinert hat. Bei der zweiten Suche sogar so klein, dass nur noch ein Strich übrig blieb.
Im von dir angepassten Original klappt es aber vorzüglich.
Der Fehler war der Zoom der Tabellenseite.
Dieser muss auf 100% stehen bleiben.
Ich hab mich nun damit beholfen.


ActiveWindow.Zoom = 100

geht... ;-)
Hier nochmal die Datei
https://www.herber.de/bbs/user/110608.xlsm
Viele Grüße
bassi

Guten Morgen Werner,
Die Nacht war nicht erholsam, da hab ich die Beispieldatei mal angepasst.
Der Tag wird sich dafür rächen... ;-)
Allerdings hat mein Excel mich bei der Speicherung auf xls komplett verlassen.
Die Datei war utopisch groß, und ich konnte/kann keine ganzen Spalten und Zeilen mehr löschen.
Meldung - Formatfehler...
Ich musste auf xlsx ausweichen und Zeilen / Spalten markieren und den nur noch zur Verfügung stehenden Befehl "Zellen löschen" verwenden. Jetzt ist die Datei zumindes so groß/klein, dass man sie hier hoch laden kann.
Das muss ich nachher erstmal ergründen...
Das wäre der Code:


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim Zeile As Long
Dim Spalte As Long
Application.ScreenUpdating = False
With Me.ListBox1
Zeile = .List(.ListIndex, 9)
Spalte = .List(.ListIndex, 8)
Sheets("Einträge").Cells(Zeile, Spalte).Select 'der Sprung müsste jetzt auf ein anderes  _
Tabellenblatt gehen - das funktioniert so aber nicht
End With
Application.ScreenUpdating = True
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
ActiveWindow.Zoom = 100
Dim rngCell As Range
Dim strFirstAddress As String
Dim rngBereich As Range
Dim strWert As String
strWert = "X"
If Target.Address = "$BU$8" Then 'Zelle an Bedürfnisse anpassen
If Target = "" Then
Target.Offset(, -3) = ""
Target.Offset(, -1) = ""
Me.ListBox1.Clear
Target.Offset(, -3).Select
Exit Sub
End If
If UCase(Target.Value) = strWert Then
Set rngBereich = Sheets("Ansicht 1").Range("a2:n" & Sheets("Ansicht 1").Cells(Rows. _
Count, _
2).End(xlUp).Row)
With rngBereich
Me.ListBox1.Clear
Set rngCell = .Find(Target.Offset(, -3).Value, LookIn:=xlValues, Lookat:=xlPart) _
If Not rngCell Is Nothing Then
strFirstAddress = rngCell.Address
Do
With Me.ListBox1
.ColumnCount = 10
If Target.Offset(, -1).Value  "" Then
If rngCell.Offset(, 2).Value = Target.Offset(, -1).Value  _
Then
.AddItem
.List(.ListCount - 1, 0) = Cells(rngCell.Row, 2)
.List(.ListCount - 1, 1) = Cells(rngCell.Row, 3)
.List(.ListCount - 1, 2) = Cells(rngCell.Row, 4)
.List(.ListCount - 1, 3) = Cells(rngCell.Row, 5)
.List(.ListCount - 1, 4) = Cells(rngCell.Row, 6)
.List(.ListCount - 1, 5) = Cells(rngCell.Row, 7)
.List(.ListCount - 1, 6) = Cells(rngCell.Row, 8)
.List(.ListCount - 1, 7) = Cells(rngCell.Row, 9)
.List(.ListCount - 1, 8) = rngCell.Column
.List(.ListCount - 1, 9) = rngCell.Row
.ColumnWidths = "1cm;2cm;2cm;1,5cm;6cm;2cm;2cm;0,5cm; _
0cm;0cm"
End If
Else
.AddItem
.List(.ListCount - 1, 0) = Cells(rngCell.Row, 2)
.List(.ListCount - 1, 1) = Cells(rngCell.Row, 3)
.List(.ListCount - 1, 2) = Cells(rngCell.Row, 4)
.List(.ListCount - 1, 3) = Cells(rngCell.Row, 5)
.List(.ListCount - 1, 4) = Cells(rngCell.Row, 6)
.List(.ListCount - 1, 5) = Cells(rngCell.Row, 7)
.List(.ListCount - 1, 6) = Cells(rngCell.Row, 8)
.List(.ListCount - 1, 7) = Cells(rngCell.Row, 9)
.List(.ListCount - 1, 8) = rngCell.Column
.List(.ListCount - 1, 9) = rngCell.Row
.ColumnWidths = "1cm;2cm;2cm;1,5cm;6cm;2cm;2cm;0,5cm;0cm; _
0cm"
End If
End With
Set rngCell = .FindNext(rngCell)
Loop While Not rngCell Is Nothing And rngCell.Address  strFirstAddress
Else
MsgBox "Suchbegriff " & Target.Offset(, 2).Value & " wurde nicht gefunden."
Target.Offset(, -3) = ""
Target.Offset(, -1) = ""
Target = ""
Target.Offset(, -3).Select
End If
End With
End If
End If
End Sub

Viele Grüße
bassi
https://www.herber.de/bbs/user/110658.xlsx
Viele Grüße
bassi

Beliebteste Forumthreads (12 Monate)

vba Suche auch bei Text mit Leerzeichen?

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

vba Suche auch bei Text mit Leerzeichen?

21 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread