Suchfunktion mit mehreren Woertern

Dieses Thema Suchfunktion mit mehreren Woertern im Forum "Microsoft Office Suite" wurde erstellt von bibbi, 15. Dez. 2007.

Thema: Suchfunktion mit mehreren Woertern Hallo an alle, Habe eine Tabelle ueber den Bestand von Weinen in einem Weinkeller erstellt. Nun moechte ich eine...

  1. Hallo an alle,

    Habe eine Tabelle ueber den Bestand von Weinen in einem Weinkeller erstellt. Nun moechte ich eine Suchfunktion einbringen, in der nach mehreren Aspekten gesucht werden kann ... z.B. Year und Name oder Variety und Year ...
    Bsp.
    Year Name Variety Size

    1996 Mount Pleasant Chardonnay 750 ml
    1989 Brands Semillon 375 ml
    1990 Casella Shiraz 1500 ml

    Noch dazu muesste alles in Englisch sein.
    Koennte mir jemand damit weiterhelfen?

    Danke
    LG Bibbi
     
  2. i just wanted beginning to answer, when i realized your last sentence. but i havent any idea to crack your problem.
     
  3. Hallo bibbi,

    was hast Du dir denn da vorgestellt ?

    1.Möglichkeit:

    Oberhalb der Überschrift gibt es noch z.B. 5 leere Zeilen.
    Dort können Begriffe oder Teile davon als Suchbegriff für
    die jeweilige Spalte eingetippt werden.
    Ein Button löst die Suche aus.
    Angezeigt werden die Überschrift und alle Zeilen, die mindestens
    in einer Zelle einen sie betreffenden Suchbegriff oder Teile davon enthalten.

    2. Möglichkeit

    Per Button wird eine Userform gestartet.
    Die Userform enthält für jede Spalte 5 DropDownListen,
    die die Begriffe der jeweiligen Spalte enthalten.
    Es können Begriffe als Suchbegriff für die jeweilige Spalte ausgesucht werden.
    Ein Button löst die Suche aus.
    Angezeigt werden die Überschrift und alle Zeilen, die mindestens
    in einer Zelle einen sie betreffenden Suchbegriff oder Teile davon enthalten.

    Gruß Matjes :)
     
  4. Hallo Matjes,

    danke fuer deine Hilfe. Mit gefaellt die 2 Moeglichkeit, habe aber leider keine Ahnung wie ich diese verwirklichen kann?!
    Kannst du mir weiterhelfen?

    Danke
    LG Bibbi
     
  5. Hallo bibbi,

    schick mir mal eine Probedatei an meinen mail-addy,
    so die ersten 10 Zeilen deiner Datei.(und vielleicht zum Probieren den entsprechenden Wein ::) )

    Ich hab schon mal einen Prototypen für Version 2 erstellt. Der hat dann noch die Erweiterung/Feature, dass man zwischen einer AND und OR Funktion zwischen den Suchbegriffsgruppen der Spalten wählen kann.

    Schick mir die Datei und ich schau mal, was ich dir da einbauen kann.

    Gruß Matjes :)

    ps: Hab mir zu dem Thema erstmal eine Flasche Rotwein genehmigt. Hick's
     
  6. Also das ist daraus geworden:

    Mappe WeinListe mit 3 Blättern.
    Blattnamen: TableOfWine, TableOfWine2, TableOfWine3

    Alle 3 Blätter haben die Spalten Year, Name, Variety, Size, die jedoch auf jedem Blatt anders liegen. Die Überschriftenzeile liegt auf allen Blättern in Zeile 2, die erste Wertezeile ist 3. Auf jedem Blatt ist ein CommandButton1 mit der Aufschrift->Search'.

    Das Makro stellt alle Werte der oben genannten Spalten in einer Auswahlmaske zur Auswahl(Name der Userform: Uf_SearchForWine). Pro Spalte ist es möglich in je 5 DropDownlisten Werte der Spalte zu selektieren. Die DropdownListen-Elemente sind für Year benannt: CB1Year, CB2Year, CB3Year, CB4Year, CB5Year. Für Name, Variety und Size sind jeweils auch 5 analog bezeichnete DropDownListen vorhanden (z.b. CB1Variety). Die Auswahlmaske enthält noch einen Frame mit 2 Radiobutton(OB_ModeOR und OB_ModeAND) zur Auswahl der Verküpfung OR oder AND der Suchbegriffe der Spalten. Außerdem ein CommandButton (Cmd_Search) , der das Ein/Ausblenden der Zeile entsprechend der suchbegriffe auslöst. (Keine Auswahl von Suchbegriffen blendet alle Zeilen ein.)

    In den Code-Seiten der Tabellenblätter muß folgender Code liegen:

    Code:
    Private Sub CommandButton1_Click()
     Call MyWineSearch
    End Sub
    in einem Modul folgender Code:

    Code:
    Option Explicit
    
    Type myWineCard_Struct
     Year As String
     Name As String
     Variety As String
     Size As String
    End Type
    
    Private Const cBLT_ANZAHL = 3-> Anzahl der Blätter mit Weinkarte
                  -> in Function Blattparameter muessen die Parameter gesetzt werden
    
    Public Const cRETURN_OK = 0
    Public Const cRETURN_TERMINATE = -1
    Public lReturn_UF_SearchWine As Long
    Public Const cSTR_NICHTSAUSGEWAEHLT = nothing selected
    
    Public bODERPRUEFUNG As Boolean
    
    'Gelesene Listen
    Public WC() As myWineCard_Struct, WCCnt As Long
    Public WCYear() As String, WCYearCnt As Long
    Public WCName() As String, WCNameCnt As Long
    Public WCVariety() As String, WCVarietyCnt As Long
    Public WCSize() As String, WCSizeCnt As Long
    
    'Listen mit Suchbegriffen
    Public SRCHYear() As String, SRCHYearCnt As Long
    Public SRCHName() As String, SRCHNameCnt As Long
    Public SRCHVariety() As String, SRCHVarietyCnt As Long
    Public SRCHSize() As String, SRCHSizeCnt As Long
    
    Sub MyWineSearch()
     Application.ScreenUpdating = False
     Call LesenDerWeinkarte
     If Not SuchbegriffeHolen Then GoTo Aufraeumen
     Call ZeilenOhneSuchbegriffenAuslenden
    Aufraeumen:
     Application.ScreenUpdating = True
    End Sub
    '*************************************************************************************
    Private Function Blattparameter(lLfdWeinkarte As Long, _
                    sBLTName As String, _
                    lZ_UEBSCHR As Long, lZ_1Z As Long, _
                    lSP_Year As Long, lSP_Name As Long, _
                    lSP_Variety As Long, lSP_Size As Long)
    ->Hier kannst du Blattparameter für verschiedene Blätter der Weinliste eingeben
    ->Es werden alle Blätter von 1 to cBLT_ANZAHL abgefahren
     
     Select Case lLfdWeinkarte
      Case 1
      ->Blattbeschreibung 1.Blatt
       sBLTName = TableOfWine
       lZ_UEBSCHR = 2: lZ_1Z = 3-> erste Wertezeile
       lSP_Year = 1: lSP_Name = 2: lSP_Variety = 3: lSP_Size = 4
      Case 2
      ->Blattbeschreibung 2.Blatt
       sBLTName = TableOfWine2
       lZ_UEBSCHR = 2: lZ_1Z = 3-> erste Wertezeile
       lSP_Year = 3: lSP_Name = 4: lSP_Variety = 5: lSP_Size = 6
      Case 3
      ->Blattbeschreibung 3.Blatt
       sBLTName = TableOfWine3
       lZ_UEBSCHR = 2: lZ_1Z = 3-> erste Wertezeile
       lSP_Year = 2: lSP_Name = 3: lSP_Variety = 4: lSP_Size = 5
     End Select
    
    End Function
    
    '*************************************************************************************
    Private Function ZeilenOhneSuchbegriffenAuslenden()
    
     Dim ws As Worksheet
     Dim lrows As Long, x As Long, b As Long
     Dim sYear As String, sName As String, sVariety As String, sSize As String
    ->Blattbeschreibung
     Dim sBLTName As String
     Dim lZ_UEBSCHR As Long, lZ_1Z As Long
     Dim lSP_Year As Long, lSP_Name As Long, lSP_Variety As Long, lSP_Size As Long
    
     If (SRCHYearCnt = 0) And _
      (SRCHNameCnt = 0) And _
      (SRCHVarietyCnt = 0) And _
      (SRCHSizeCnt = 0) Then GoTo Aufraeumen
     
     For b = 1 To cBLT_ANZAHL
     
      Call Blattparameter(b, sBLTName, lZ_UEBSCHR, lZ_1Z, lSP_Year, lSP_Name, lSP_Variety, lSP_Size)
     
      Set ws = ActiveWorkbook.Worksheets(sBLTName)
      lrows = ZeilenZahlWeinkarteBestimmen(ws, lSP_Year, lSP_Name, lSP_Variety, lSP_Size)
      If bODERPRUEFUNG Then
       ws.Rows(lZ_1Z & : & lrows).Hidden = False
      Else
       ws.Rows(lZ_1Z & : & lrows).Hidden = True
      End If
      
       
      For x = lrows To lZ_1Z Step -1
       sYear = ws.Cells(x, lSP_Year).Value:   TrimMe (sYear)
       sName = ws.Cells(x, lSP_Name).Value:   TrimMe (sName)
       sVariety = ws.Cells(x, lSP_Variety).Value: TrimMe (sVariety)
       sSize = ws.Cells(x, lSP_Size).Value:   TrimMe (sSize)
       
       If bODERPRUEFUNG Then
       
       ->wenn kein Suchbegriff trifft ausblenden (ODER)
        If (Not IstSuchbegriff(SRCHYear(), SRCHYearCnt, sYear)) And _
         (Not IstSuchbegriff(SRCHName(), SRCHNameCnt, sName)) And _
         (Not IstSuchbegriff(SRCHVariety(), SRCHVarietyCnt, sVariety)) And _
         (Not IstSuchbegriff(SRCHSize(), SRCHSizeCnt, sSize)) Then _
         ws.Rows(x).Hidden = True
       Else
       ->wenn ein Suchbegriff nicht trifft ausblenden (UND)
        If (IstSuchbegriff2(SRCHYear(), SRCHYearCnt, sYear)) And _
         (IstSuchbegriff2(SRCHName(), SRCHNameCnt, sName)) And _
         (IstSuchbegriff2(SRCHVariety(), SRCHVarietyCnt, sVariety)) And _
         (IstSuchbegriff2(SRCHSize(), SRCHSizeCnt, sSize)) Then _
         ws.Rows(x).Hidden = False
         
       End If
      Next
     Next
    Aufraeumen:
     Set ws = Nothing
    End Function
    '*************************************************************************************
    Private Function IstSuchbegriff2(f() As String, fcnt As Long, s As String) As Boolean
     Dim x As Long
     If fcnt = 0 Then IstSuchbegriff2 = True: Exit Function
     IstSuchbegriff2 = False
     For x = 1 To fcnt
      If f(x) = s Then IstSuchbegriff2 = True: Exit Function
     Next
    End Function
    '*************************************************************************************
    Private Function IstSuchbegriff(f() As String, fcnt As Long, s As String) As Boolean
     Dim x As Long
     IstSuchbegriff = False
     For x = 1 To fcnt
      If f(x) = s Then IstSuchbegriff = True: Exit Function
     Next
    End Function
    
    '*************************************************************************************
    Private Function SuchbegriffeHolen() As Boolean
     
     Dim x As Long
     SRCHYearCnt = 0: SRCHNameCnt = 0: SRCHVarietyCnt = 0: SRCHSizeCnt = 0
     
     Load Uf_SearchForWine
     Call SuchbegriffeInDorpdownListenSchreiben(Uf_SearchForWine, Year, WCYear(), WCYearCnt)
     Call SuchbegriffeInDorpdownListenSchreiben(Uf_SearchForWine, Name, WCName(), WCNameCnt)
     Call SuchbegriffeInDorpdownListenSchreiben(Uf_SearchForWine, Variety, WCVariety(), WCVarietyCnt)
     Call SuchbegriffeInDorpdownListenSchreiben(Uf_SearchForWine, Size, WCSize(), WCSizeCnt)
     lReturn_UF_SearchWine = cRETURN_TERMINATE
     Uf_SearchForWine.Show
     
     If lReturn_UF_SearchWine <> cRETURN_OK Then Unload Uf_SearchForWine: Exit Function
     
    ->Suchbegriffe feststellen
     Call SuchbegriffeAusDorpdownListenLesen(Uf_SearchForWine, Year, SRCHYear(), SRCHYearCnt)
     Call SuchbegriffeAusDorpdownListenLesen(Uf_SearchForWine, Name, SRCHName(), SRCHNameCnt)
     Call SuchbegriffeAusDorpdownListenLesen(Uf_SearchForWine, Variety, SRCHVariety(), SRCHVarietyCnt)
     Call SuchbegriffeAusDorpdownListenLesen(Uf_SearchForWine, Size, SRCHSize(), SRCHSizeCnt)
    
    ->Mode für die Verknüpfung der Spalten
     bODERPRUEFUNG = Uf_SearchForWine.OB_ModeOR.Value
    
     SuchbegriffeHolen = True
    Aufraeumen:
     Unload Uf_SearchForWine
    End Function
    '*************************************************************************************
    Private Function SuchbegriffeAusDorpdownListenLesen( _
             UF As UserForm, sObj As String, f() As String, fcnt As Long)
     Dim x As Long, y As Long, bFound As Boolean
     
     fcnt = 0: ReDim f(1 To 1)
     For x = 1 To 5
      If UF.Controls(CB & x & sObj).ListIndex > 0 Then
       If UF.Controls(CB & x & sObj).Text <>  Then
        bFound = False
        For y = 1 To fcnt
         If f(y) = UF.Controls(CB & x & sObj).Text Then bFound = True: Exit For
        Next
        If Not bFound Then
         fcnt = fcnt + 1: ReDim Preserve f(1 To fcnt)
         f(fcnt) = UF.Controls(CB & x & sObj).Text
        End If
       End If
      End If
     Next
     
    End Function
    '*************************************************************************************
    Private Function SuchbegriffeInDorpdownListenSchreiben( _
             UF As UserForm, sObj As String, f() As String, fcnt As Long)
     Dim x As Long
    
     UF.Controls(CB1 & sObj).AddItem cSTR_NICHTSAUSGEWAEHLT
     For x = 1 To fcnt: UF.Controls(CB1 & sObj).AddItem f(x): Next
     UF.Controls(CB1 & sObj).ListIndex = 0
     For x = 2 To 5
      UF.Controls(CB & x & sObj).List = UF.Controls(CB1 & sObj).List
      UF.Controls(CB & x & sObj).ListIndex = 0
     Next
    
    End Function
    '*************************************************************************************
    Private Function ZeilenZahlWeinkarteBestimmen(ws As Worksheet, _
                           lSP_Year As Long, lSP_Name As Long, _
                           lSP_Variety As Long, lSP_Size As Long) As Long
     Dim lrows As Long, x As Long, sp As Long
     
    ->Zeilenanzahl bestimmen
     lrows = 0
     For x = 1 To 4
      Select Case x
       Case 1: sp = lSP_Year
       Case 2: sp = lSP_Name
       Case 3: sp = lSP_Variety
       Case 4: sp = lSP_Size
      End Select
      If lrows < ws.Cells(ws.Rows.Count, sp).End(xlUp).Row Then lrows = ws.Cells(ws.Rows.Count, sp).End(xlUp).Row
     Next
     ZeilenZahlWeinkarteBestimmen = lrows
    End Function
    '*************************************************************************************
    Private Function LesenDerWeinkarte() As Boolean
     
     Dim ws As Worksheet
     Dim lrows As Long, x As Long, sp As Long, b As Long
     Dim sYear As String, sName As String, sVariety As String, sSize As String
     Dim sBLTName As String
     Dim lZ_UEBSCHR As Long, lZ_1Z As Long
     Dim lSP_Year As Long, lSP_Name As Long, lSP_Variety As Long, lSP_Size As Long
    
     WCCnt = 0: ReDim WC(1 To 1)
     WCYearCnt = 0: ReDim WCYear(1 To 1)
     WCNameCnt = 0: ReDim WCName(1 To 1)
     WCVarietyCnt = 0: ReDim WCVariety(1 To 1)
     WCSizeCnt = 0: ReDim WCSize(1 To 1)
     
     For b = 1 To cBLT_ANZAHL
     
      Call Blattparameter(b, sBLTName, lZ_UEBSCHR, lZ_1Z, lSP_Year, lSP_Name, lSP_Variety, lSP_Size)
      
      Set ws = ActiveWorkbook.Worksheets(sBLTName)
      ws.Rows.Hidden = False
      
     ->Zeilenanzahl bestimmen
      lrows = ZeilenZahlWeinkarteBestimmen(ws, lSP_Year, lSP_Name, lSP_Variety, lSP_Size)
      
      For x = lZ_1Z To lrows
      ->Begriffe as Zeile
       sYear = ws.Cells(x, lSP_Year).Value:   TrimMe (sYear)
       sName = ws.Cells(x, lSP_Name).Value:   TrimMe (sName)
       sVariety = ws.Cells(x, lSP_Variety).Value: TrimMe (sVariety)
       sSize = ws.Cells(x, lSP_Size).Value:   TrimMe (sSize)
       If sYear =  And sName =  And sVariety =  And sSize =  Then GoTo NAECHSTEZEILE
       
      ->in Struktur eintragen
       WCCnt = WCCnt + 1
       If WCCnt > UBound(WC()) Then ReDim Preserve WC(1 To WCCnt + 10)
       WC(WCCnt).Year = sYear
       WC(WCCnt).Name = sName
       WC(WCCnt).Variety = sVariety
       WC(WCCnt).Size = sSize
       
      ->in Liste eintragen, wenn noch nicht vorhanden
       Call MakeListOfDifferentMembers(WCYear(), WCYearCnt, sYear)
       Call MakeListOfDifferentMembers(WCName(), WCNameCnt, sName)
       Call MakeListOfDifferentMembers(WCVariety(), WCVarietyCnt, sVariety)
       Call MakeListOfDifferentMembers(WCSize(), WCSizeCnt, sSize)
     
    NAECHSTEZEILE:
      Next
     Next
     
     If WCCnt = 0 Then MsgBox Winecards empty: GoTo Aufraeumen
     If WCYearCnt = 0 Then MsgBox Columns->Year' empty: GoTo Aufraeumen
     If WCNameCnt = 0 Then MsgBox Columns->Name' empty: GoTo Aufraeumen
     If WCVarietyCnt = 0 Then MsgBox Columns->Variety' empty: GoTo Aufraeumen
     If WCSizeCnt = 0 Then MsgBox Columns->Size' empty: GoTo Aufraeumen
     
     Call StringListSort(WCYear(), WCYearCnt, False)
     Call StringListSort(WCName(), WCNameCnt, True)
     Call StringListSort(WCVariety(), WCVarietyCnt, True)
     Call StringListSort(WCSize(), WCSizeCnt, False)
     
     LesenDerWeinkarte = True
    Aufraeumen:
     Set ws = Nothing
     
    End Function
    
    '*************************************************************************************
    Private Function StringListSort(f() As String, fcnt As Long, bLinksSortieren As Boolean)
    
     Dim sTmp As String, s1 As String, s2 As String
     Dim x As Long, y As Long
     Dim bSort As Boolean
     
     Const lMAXSTRLNG = 100
     
     If fcnt < 2 Then Exit Function
     For x = 1 To fcnt
      For y = x + 1 To fcnt
       bSort = False
       If bLinksSortieren Then
        s1 = f(x) & String(lMAXSTRLNG - Len(f(x)), Chr(32))
        s2 = f(y) & String(lMAXSTRLNG - Len(f(y)), Chr(32))
        If s1 > s2 Then bSort = True
       Else
        s1 = String(lMAXSTRLNG - Len(f(x)), Chr(32)) & f(x)
        s2 = String(lMAXSTRLNG - Len(f(y)), Chr(32)) & f(y)
        If s1 > s2 Then bSort = True
       End If
       If bSort Then sTmp = f(x): f(x) = f(y): f(y) = sTmp
      Next
     Next
    
    End Function
    
    '*************************************************************************************
    Private Function MakeListOfDifferentMembers(f() As String, fcnt As Long, s As String)
     
     Dim x As Long, bFound As Boolean
     
     bFound = False
     For x = 1 To fcnt
      If f(x) = s Then bFound = True: Exit For
     Next
     If Not bFound Then
      fcnt = fcnt + 1
      If fcnt > UBound(f()) Then ReDim Preserve f(1 To fcnt + 10)
      f(fcnt) = s
     End If
    End Function
    '*************************************************************************************
    Function TrimMe(sText As String)
     
     Dim lLen As Long, x As Long
     
     lLen = Len(sText)
     If lLen = 0 Then Exit Function
     For x = 1 To lLen
      If Chr(32) = Mid(sText, 1, 1) Then sText = Right(sText, Len(sText) - 1)
     Next
     lLen = Len(sText)
     If lLen = 0 Then Exit Function
     For x = 1 To lLen
      If Chr(32) = Mid(sText, Len(sText), 1) Then sText = Left(sText, Len(sText) - 1)
     Next
    End Function
    Gruß Martjes :)
     
Die Seite wird geladen...

Suchfunktion mit mehreren Woertern - Ähnliche Themen

Forum Datum
Suchfunktion arbeitet unvollständig Windows 7 Forum 27. Feb. 2014
Linkfavoriten und Suchfunktion F3 Windows 7 Forum 28. Aug. 2011
Suchfunktion + Startmenüordner Problem Software: Empfehlungen, Gesuche & Problemlösungen 18. Jan. 2010
Wie alte Einträge in der Suchfunktion löschen? [GELÖST] Windows 7 Forum 15. Juli 2009
Komme mit der Suchfunktion in Windows 8 nicht klar Windows 8 Forum 3. März 2013