Hallo Leute,
ich hätte da mal ne Frage zu folgendem Problem, den ich lösen müsste:
Beim Klicken auf einem Button öffnet sich eine InputBox.
In dieser InputBox gibt der User ein Suchtext ein (dieser kann ein Teil des gesuchten Textes sein, soll auch nicht zwischen Groß- und Kleinbuchstaben unterscheiden)
Gesucht wird um ein Beispiel zu nennen in der "Tabelle1", Range("A2:A10") nach Übereinstimmungen, hier stehen die Texte jedoch meist mehrfach drin.
Das Makro soll alle Übereinstimmungen mit dem Suchtext auflisten, jedoch ohne Doppler!
z.B.:
Kunde1a
Kunde2a
Kunde2a
Kunde2b
Kunde3a
Bei Eingabe des Suchtextes "kunde2" , sollen folgende Übereinstimmungen ausgegeben werden:
Kunde2a
Kunde2b
Hat jemand ne Ahnung wie ich diesen Filter und die Übergabe an die ListBox hinbekommen kann?
Ich bedanke mich schon mal im Voraus!
Lg aus Südtirol :)
Gustav
Ich würde den Bereich wie eine Datenbanktabelle behandeln.
Private Sub CommandButton1_Click()
Dim cnn As Object
Dim prm As Object
Const adCmdText = 1
Const adWChar = 130
Set cnn = CreateObject("ADODB.Connection")
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Data Source").Value = ActiveWorkbook.FullName
.Properties("Extended Properties").Value = "Excel 12.0;HDR=1;IMEX=1"
.Open
End With
With CreateObject("ADODB.Command")
.ActiveConnection = cnn
.CommandText = "SELECT DISTINCT X FROM [sheet1$A1:A6] WHERE X Like ?"
.CommandType = adCmdText
Set prm = .CreateParameter("Kunde", adWChar, , 255, TextBox1 & "%")
.Parameters.Append prm
With .Execute
If Not .EOF Then
ListBox1.Column = .GetRows()
Else
ListBox1.Clear
End If
End With
End With
cnn.Close
End Sub
Hallo Lachtaube,
vielen Dank erstmal für Deine Bemühungen!
Ich bin mir jetzt nicht ganz sicher ob ich es auch verstanden habe, aber ist diese Code nicht etwa für Access gedacht?
Ich habe dieses Problem in Excel...
Beim Versuch diese Code in Excel auszuführen stoppte das Makro in der Codezeile 'With .Execute' und ich bekam folgende Fehlermeldung auf dem Bildschirm:
Zitat
Laufzeitfehler `-2147217865 (80040e37)':
Das Microsoft Access-Datenbankmodul konnte das Objekt 'sheet1$A1:A6' nicht finden.
Stellen Sie sicher, dass das Objekt vorhanden ist und dass die Namens- und
Pfadangabe richtig eingegeben wurden. Ist 'sheet1$A1:A6' kein lokales Objekt, sollten
Sie die Netzwerkverbindung prüfen oder sich an den Serveradministrator wenden.
Kannst Du oder ein anderer Excel/VBA-Profi mir hier weiterhelfen?
***************************************************************************************************
Hier nochmals in meinem Beispiel kurz das Problem erklärt:
1.) In der Excel-Tabelle "Tabelle1" habe ich einen Button "Kundensuche".
2.) Bei Klick öffnet sich eine InputBox, wo der User den Namen des gesuchten Kunden (Variable "Kunde") eingibt
(mit oder ohne genaue Übereinstimmung, zwischen Groß-und Kleinschreibung soll nicht unterschieden werden).
3.) Dieser durchsucht im Range "A2:A10" der Tabelle den eingegebenen Suchtext.
4.) a - Wir dieser einmalig gefunden, so soll er in der Spalte "A" einen Filter setzen
und die Variable "Kunde" als Filterkriterium setzen...
z.B.:
With Worksheets("Tabelle1")
.Range("$A$1:$A$10").AutoFilter Field:=1, Criteria1:=Kunde
End With
Und hier mein eigentliches Problem:
4.) b - Wir dieser jedoch mehrmals gefunden so soll sich eine UserForm ("UserForm1") öffnen mit einer ListBox ("ListBox1"),
worin die Suchergebnisse einmalig aufgelistet werden, also ohne doppelte Einträge!
Bei Klick in die "ListBox1" auf einen ListBox-Eintrag, wird dieser genauso behandelt wie unter Punkt 4.) a !
***************************************************************************************************
Ich bedanke mich schon mal jetzt dafür!
LG, Gustav
ADODB kann mit allem, wofür es einen Provider gibt. Und der für Access versteht sich auch auf Excel-Blätter bzw. -Bereiche. Namensanpassungen musst Du selbst vornehmen. Mein Datenblatt heißt Sheet1 und Deines Tabelle1 und in A1 steht der Feldname (heißt bei mir X).
Hallo Lachtaube,
vielen Dank für die Erläuterungen.
Ich habe nun mein Problem wie folgt gelöst:
In Modul1:
Option Explicit
Public Kunde_n(10) As String
Public Kunde_a(10) As String
Public z As Integer
Public zz As Integer
Public KundenMatch As String
Sub KundenFilter_Klicken()
Dim Kunde As String
Dim c As Range
Dim firstAddress As String
Dim m As Integer
Dim i As Integer
'Einfachheitshalber schlägt die InputBox in diesem Beispiel die Variable Kunde "kunde2" bereits vor...
Kunde = InputBox("Geben Sie hier den Kunden ein!" & vbNewLine & vbNewLine & _
"Eingabe des vollen oder auch eines Teiles des Namen möglich," & vbNewLine & _
"zwischen Groß- und Kleinschreibweise wird nicht unterschieden!", "Kundensuche", "kunde2")
With Worksheets("Tabelle1")
.Range("$A$1:$C$10").AutoFilter Field:=1
End With
With Worksheets("Tabelle1").Range("A2:A10")
Set c = .Find("*" & Kunde & "*", LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
firstAddress = c.Address
z = 0
Do
z = z + 1
Kunde_n(z) = Worksheets("Tabelle1").Cells(c.Row, c.Column).Value
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Liste.Show
End With
End Sub
In der UserForm ("UserForm1") mit einer ListBox ("ListBox1") habe ich folgenden Code geschrieben:
Option Explicit
Private Sub UserForm_Initialize()
Dim i As Integer
With Liste.ListBox1
.Clear
zz = 0
For i = 1 To z
If Kunde_n(i - 1) <> Kunde_n(i) Then
zz = zz + 1
Kunde_a(zz) = Kunde_n(i)
.AddItem Kunde_a(zz)
End If
Next i
End With
End Sub
Private Sub ListBox1_Click()
KundenMatch = ListBox1.Value
With Worksheets("Tabelle1")
.Range("$A$1:$A$10").AutoFilter Field:=1, Criteria1:=KundenMatch
End With
Unload Me
End Sub
Funktioniert wie gewollt! ;)
Wenn's jemanden interessiert findet Ihr die Tabelle im Anhang!
Lg, Gustav