Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1848to1852
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Erweiterung alle Spalten

Erweiterung alle Spalten
26.09.2021 12:19:01
Thomas
Hallo Excelfreunde;
bezugnehmend zu Beitrag
https://www.herber.de/forum/cgi-bin/callthread.pl?index=1843851
habe ich eine Frage.
Kann man dieses super Makro auch so einstellen das ich eine Textbox habe mit der man alle Spalten gleichzeitig durchsuchen kann?
Ich versuche dies schon seid einer Woche aber es will einfach nicht gelingen.
Dies wäre die original Datei;
https://www.herber.de/bbs/user/148272.xlsm
Und dies ist mein derzeitiger Stand
https://www.herber.de/bbs/user/148273.xlsm.
Welcher natürlich so nicht funktionieren kann.
Das ideale wäre wenn mit der Textbox6 eine suche über alle Spalten durchführt und man dann anschließend die Suche in den einzelnen Spalten verfeinern kann.
Kann sich dies mal jemand anschauen?
Habt schon mal rechtvielen dank für euer Interesse.
MFG Thomas

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Erweiterung alle Spalten
26.09.2021 12:59:22
oraculix
Hallo hoffe hab Dich richtig verstanden versuch das mal!
Gruß
Oraculix
'Suchen mit TxtBox

Private Sub TextBox6_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
'bei Return Makro ausführen
Dim TB As Worksheet, rng As Range, C As Range, TTXT As String, firstAddress As String
Dim Anz As Integer, JaNein As Variant, Arr, i As Integer
Set TB = Sheets("Tabelle1") 'hier deine Tabelle reinschreiben
Set rng = TB.Range("A1:GF300") 'Range auswählen die durchsucht wird
With TextBox6
If .Text  "" Then
Set C = rng.Find(.Text, LookAt:=xlPart)
If Not C Is Nothing Then
firstAddress = C.Address
Do
Set C = rng.FindNext(C)
'Fundstellen sammeln
TTXT = TTXT & "; " & C.Address(0, 0)
Anz = Anz + 1
Loop While Not C Is Nothing And C.Address  firstAddress
Arr = Split(TTXT, "; ") 'Array zum Anspringen
For i = 1 To Anz
JaNein = MsgBox(Anz & "x gefunden in:" & vbLf & TTXT & vbLf & vbLf _
, vbYesNo, "Zum Treffer " & i & " / " & Anz & " hinspringen?   J / N")
If JaNein = vbYes Then
Application.Goto Range(Arr(i))
Else
Exit For
End If
Next
Else
MsgBox "Kein Fund"
End If
End If
End With
End If
End Sub

Anzeige
AW: Erweiterung alle Spalten
26.09.2021 14:08:34
ralf_b
So ist das wenn man fertige Codes umbauen will aber den Code nicht versteht.
In diesem Falle : einer Suche über Alles ist es einfacher als du denkst.
Bitteschön.

Sub sucheninAlle()
Dim i As Long, k As Long, l As Long
Dim out()
Dim data
Dim Suchstring As String
Const LetzteSpalte = 24                       '24: Spalte X
Application.ScreenUpdating = False
Application.EnableEvents = False
'Application.Calculation = xlCalculationManual
ReDim out(1 To LetzteSpalte, 1 To 1)
With Worksheets("Kundendaten")
data = .Range(.Cells(3, 1), .Cells(.Range("A99999").End(xlUp), LetzteSpalte)).Value
For l = LBound(data) To UBound(data)
'Prüfung der aktuelle Zeile
Suchstring = ""
For i = LBound(data, 2) To UBound(data, 2)
Suchstring = Suchstring & data(l, i) & "|"
Next
If InStr(1, Suchstring, TextBox6.Text) > 0 Then
k = k + 1
ReDim Preserve out(1 To LetzteSpalte, 1 To k)
For i = 1 To LetzteSpalte
out(i, k) = .Cells(l + 2, i).Value
Next
End If
Next
Suchergebnisse_suchen_2.Clear
If k = 1 Then
Suchergebnisse_suchen_2.Column = out
ElseIf k > 1 Then
Suchergebnisse_suchen_2.List = WorksheetFunction.Transpose(out)
End If
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub

Anzeige
AW: Erweiterung alle Spalten
26.09.2021 16:18:05
onur
Und wofür genau sind diese Zeilen nötig? :)
Application.ScreenUpdating = False
Application.EnableEvents = False
'Application.Calculation = xlCalculationManual
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Tempo...
26.09.2021 16:50:05
{Boris}
Hi,
...Flackern verhindern usw.
VG, Boris
AW: Erweiterung alle Spalten
26.09.2021 17:37:15
Thomas
Hallo oraculix und ralf_b,
habt recht vielen dank für eure Vorschläge.
Leider ist dies nicht so richtig was ich suche.
Ich möchte gern mit der Textbox6 die gesamte Listbox durchsuchen. Z.B nach dem Begriff "Thomas".
Mit den Trefferzeilen soll dann die Listbox gefüllt werden.
MIt Hilfe der anderen Textboxen möchte ich dann gern diese gefundene Werte Spaltenweise weiter Filtern.
Anbei mein derzeitiger Stand
Dim strRef As String
Dim i, j, k, l
Dim bValid As Boolean
Dim out()
Const LetzteSpalte = 24 '24: Spalte X
Application.ScreenUpdating = False
Application.EnableEvents = False
'Application.Calculation = xlCalculationManual
Worksheets("Filtertabelle").Cells.ClearContents
ReDim out(1 To LetzteSpalte, 1 To 1)
'Herstellung der Kombinationen
'For i = 1 To 4
strRef = Kombiniere(strRef, Kunden_suchen_2.Controls("TextBox" & 6).Text)
'Next
With Worksheets("Kundendaten")
For l = 3 To .Range("A99999").End(xlUp).Row
'Prüfung der aktuelle Zeile gegen alle Kombination
' If strRef = "*;*;*;*;*" Then 'Verkürzung: keine Filterung
' bValid = True
' Else
' bValid = False
For Each E In Split(strRef, "|") ' alle Kombinationen einzel durchgehen
Liste = Split(";" & E, ";")
For g = 1 To 1
bValid = LCase(.Cells(l, g).Value) Like LCase(Liste(g))
Next
'If bValid Then Exit For 'Ist eine Kombi gültig, spart man sich den Rest
' Next ' next5 war hier
' End If
If bValid Then
k = k + 1
ReDim Preserve out(1 To LetzteSpalte, 1 To k + 1)
For i = 1 To LetzteSpalte
out(i, k) = .Cells(l, i).Value
Next
End If
Next ' next5 war hier
Next
End With
Suchergebnisse_suchen_2.Clear
Suchergebnisse_suchen_2.List = WorksheetFunction.Transpose(out)
Application.ScreenUpdating = True
Application.EnableEvents = True
'Application.Calculation = xlCalculationManual
End Sub

Function Kombiniere(ByVal Basis, Neue) As String
Dim E, B
Dim tmp
Const cAB = "@@@@@" 'Ausnahme-Blocker
If Basis = "" Then Basis = cAB
For Each B In Split(Basis, "|")
B = IIf(B = cAB, "", B & ";")
If Neue = "" Then Neue = cAB
For Each E In Split(Neue, ";")
E = IIf(E = cAB, "*", E & "*")
tmp = tmp & "|" & B & E
Next
Next
Kombiniere = Mid(tmp, 2)
End Function
Mit dieser Zeile
For g = 1 To 1
bValid = LCase(.Cells(l, g).Value) Like LCase(Liste(g))
Next
kann ich schon mal die erste Spalte gezielt durchsuchen. Sobald ich aber an der 1 etwas ändere erscheint immer die Meldung
" Index ausserhalb des gültigen Bereichs"
An welcher stelle müsste ich den Bereich entsprechend erweitern?
Oder bin ich mit meinem Ansatz komplett falsch?
mfg thomas
Anzeige
AW: Erweiterung alle Spalten
26.09.2021 17:48:10
Thomas
Hallo Excelfreunde,
erstmal rechtvielen dank für eure Lösungsvorschläge.
Leider ist dies noch nicht das gesuchte.
Ich möchte gern mit der Textbox6 die komplette Listbox durchsuchen.
Z.B. nach den Begriff " Thomas". Alle gefundenen Zeilen sollen dann in der Listbox erscheinen.
Anschließend möchte ich gern mit den restlichen TextBoxen die suche Spaltenweise verfeinern.
Mein derzeitiger Stand ist:

Sub suchen()
' Achtung dies Option Compare Text gehört mit dazu
'https://www.ms-office-forum.net/forum/showthread.php?t=268236
'ransi
Dim strRef As String
Dim i, j, k, l
Dim bValid As Boolean
Dim out()
Const LetzteSpalte = 24 '24: Spalte X
Application.ScreenUpdating = False
Application.EnableEvents = False
'Application.Calculation = xlCalculationManual
Worksheets("Filtertabelle").Cells.ClearContents
ReDim out(1 To LetzteSpalte, 1 To 1)
'Herstellung der Kombinationen
'For i = 1 To 4
strRef = Kombiniere(strRef, Kunden_suchen_2.Controls("TextBox" & 6).Text)
'Next
With Worksheets("Kundendaten")
For l = 3 To .Range("A99999").End(xlUp).Row
'Prüfung der aktuelle Zeile gegen alle Kombination
'        If strRef = "*;*;*;*;*" Then 'Verkürzung: keine Filterung
'            bValid = True
'        Else
' bValid = False
For Each E In Split(strRef, "|") ' alle Kombinationen einzel durchgehen
Liste = Split(";" & E, ";")
For g = 1 To 1
bValid = LCase(.Cells(l, g).Value) Like LCase(Liste(g))
Next
'If bValid Then Exit For 'Ist eine Kombi gültig, spart man sich den Rest
' Next ' next5  war hier
' End If
If bValid Then
k = k + 1
ReDim Preserve out(1 To LetzteSpalte, 1 To k + 1)
For i = 1 To LetzteSpalte
out(i, k) = .Cells(l, i).Value
Next
End If
Next ' next5  war hier
Next
End With
Suchergebnisse_suchen_2.Clear
Suchergebnisse_suchen_2.List = WorksheetFunction.Transpose(out)
Application.ScreenUpdating = True
Application.EnableEvents = True
'Application.Calculation = xlCalculationManual
End Sub

Function Kombiniere(ByVal Basis, Neue) As String
Dim E, B
Dim tmp
Const cAB = "@@@@@" 'Ausnahme-Blocker
If Basis = "" Then Basis = cAB
For Each B In Split(Basis, "|")
B = IIf(B = cAB, "", B & ";")
If Neue = "" Then Neue = cAB
For Each E In Split(Neue, ";")
E = IIf(E = cAB, "*", E & "*")
tmp = tmp & "|" & B & E
Next
Next
Kombiniere = Mid(tmp, 2)
End Function
Mit diesen Zeilen
For g = 1 To 1
bValid = LCase(.Cells(l, g).Value) Like LCase(Liste(g))
Next
kann ich schon mal die erste Spalte gezielt ansprechen. Sobald ich jedoch aus der eins eine andere Zahl mache erscheint immer
die Meldung " Index außerhalb des gültigen Bereichs"
An welcher Stelle muss ich den Bereich erweitern?
Oder liege ich komplett daneben?
mfg Thomas
Anzeige
AW: Erweiterung alle Spalten
26.09.2021 19:54:45
ralf_b
Veto!
der Code ,den ich dir gegeben habe macht genau das - ** Ich möchte gern mit der Textbox6 die komplette Listbox durchsuchen. **
Dieser Zusatz das du anschließend das Suchergebnis verfeinern möchtest ist aus meiner Sicht unnötig. Erinnere dich wieviel Zeit du damit schon zugebracht hast.
Zudem geht das mit dem Code von Yal nicht so einfach, da immer die Daten aus der Tabelle ausgelesen werden und nicht die Listboxinhalte.
AW: Erweiterung alle Spalten
26.09.2021 20:25:57
Thomas
Hallo ralf_b,
ja ich denke du hast recht.
Ich habe gerade auch die Idee, das ich mit deinem Code die Haupttabelle filtern kann.
Die Ergebnisse kann ich dann in ein zusätzlichen Tabellenblatt schreiben. Von da aus gehts dann mit dem Originalen Code weiter.
Dies sollte ich hinbekommen.
Hab rechtvielen dank für deine Hilfe.
mfg thomas
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige