collapse

* Benutzer Info

 
 
Willkommen Gast. Bitte einloggen oder registrieren. Haben Sie Ihre Aktivierungs E-Mail übersehen?

* Wer ist Online

  • Punkt Gäste: 80
  • Punkt Versteckte: 1
  • Punkt Mitglieder: 1

Es sind keine Mitglieder online.

* Forenstatistik

  • stats Mitglieder insgesamt: 13991
  • stats Beiträge insgesamt: 66698
  • stats Themen insgesamt: 8991
  • stats Kategorien insgesamt: 5
  • stats Boards insgesamt: 17
  • stats Am meisten online: 415

Autor Thema: Excel VBA - Teilstring in Spalte ohne Doppler in eine UserForm-ListBox schreiben  (Gelesen 214 mal)

Offline Pergus

  • Access-Profi
  • **
  • Beiträge: 130
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
Win7, Office Professional 2010
 

Offline Lachtaube

  • Access Guru
  • ****
  • Beiträge: 1254
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

« Letzte Änderung: Juni 06, 2018, 09:34:06 von Lachtaube »
Grüße von der (⌒▽⌒)
 

Offline Pergus

  • Access-Profi
  • **
  • Beiträge: 130
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
Win7, Office Professional 2010
 

Offline Lachtaube

  • Access Guru
  • ****
  • Beiträge: 1254
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).
Grüße von der (⌒▽⌒)
 

Offline Pergus

  • Access-Profi
  • **
  • Beiträge: 130
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
« Letzte Änderung: Juni 06, 2018, 17:44:25 von Pergus »
Win7, Office Professional 2010