VBA Zählen wenn Kriterien erfüllt Array

Bild

Betrifft: VBA Zählen wenn Kriterien erfüllt Array
von: Crizz
Geschrieben am: 09.06.2015 07:47:23

Hallo Forumsmitglieder,
ich habe folgenden Code um eine Spalte mit einer Oder-Bedingung nach zwei Wörtern durchzusuchen.

  • 
    Sub Search()
     Dim Zähler As Long
     Dim to_End As Long
     Dim eintragCheck As Variant
     Dim varArr As Variant
     Dim lngAnzahl As Long
     
     With Sheets("Datenblatt").Activate
     to_End = Cells(Rows.Count, 6).End(xlUp).Row
     
     For Zähler = 2 To to_End
      If Cells(Zähler, 6) Like "*" & "Ausrundung" & "*" Or Cells(Zähler, 6) Like "*" & "blend" & "*" _
     _
     Then
                 lngAnzahl = lngAnzahl + 1
             End If
         Next Zähler
         
         Worksheets("Auswertung").Range("B4").Value = lngAnzahl
        
     End With
         
     End Sub


  • Meine Frage hierzu wäre wie könnte man das in einen Array verpacken bzw Dynamischer gestalten um Kriterien hinzuzufügen oder zu löschen?
    Desweiteren würde es mich interessieren ob man die Wörter unabhängig der Groß- und Kleinschreibung durchsuchen kann?
    Danke und viele Grüße
    Chris

    Bild

    Betrifft: AW: VBA Zählen wenn Kriterien erfüllt Array
    von: hary
    Geschrieben am: 09.06.2015 08:45:45
    Moin
    Mach eine Liste in einem anderen Blatt.
    Bsp.



    Liste

     A
    1Ausrundung
    2blend
    3WasAuchImmer

    http://excel-inn.de/dateien/vba_beispiele/tabellenanzeige_in_html_addin.zip
    http://hajo-excel.de/tools.htm
    XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007
    Add-In-Version 14.02 einschl 64 Bit

    Diese Liste klapperst du in einer Schleife ab und mit Zaehlenwenn(CountIf) zaehlst du.
    Dim Zähler As Long
    Dim lngAnzahl As Long
     With Sheets("Liste")
      For Zähler = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
        lngAnzahl = lngAnzahl + Application.CountIf(Worksheets("Datenblatt").Columns(6), "*" & . _
    Cells(Zähler, 1) & "*")
      Next
          Worksheets("Auswertung").Range("B4").Value = lngAnzahl
     End With

    gruss hary

    Bild

    Betrifft: AW: VBA Zählen wenn Kriterien erfüllt Array
    von: Crizz
    Geschrieben am: 09.06.2015 09:44:26
    Hallo Harry,
    danke für deine Hilfe. Ich habe das jetzt so realisiert wie du es gesagt hast allerdings habe ich nun das Problem, dass sobald beide Suchbegriffe in einer Zelle vorkommen diese doppelt gezählt wird. Kann man das irgendwie umgehen?
    Veiel Grüße Chris

    Bild

    Betrifft: AW: VBA Zählen wenn Kriterien erfüllt Array
    von: Daniel
    Geschrieben am: 09.06.2015 10:46:19
    Hi
    probiers mal so:, die Suchbegriffe stehten im gleichnamigen Array und müssen mit "*" anfangen und enden, wenn die Suchbedinung "enthält" sein soll.
    eine durchgängige Kleinschreibung erzeugt LCase.

    Sub Search()
       Dim Zähler As Long
       Dim to_End As Long
       Dim eintragCheck As Variant
       Dim varArr As Variant
       Dim lngAnzahl As Long
       Dim sb As Long
       Dim Suchbegriffe
       
       '--- Suchbegriffe auflisten in Kleinschreibung, mit Joker * an Anfang und ende
       Suchbegriffe = Array("*ausrundung*", "*blend*")
       
       With Sheets("Datenblatt")
            to_End = .Cells(.Rows.Count, 6).End(xlUp).Row
            
            For Zähler = 2 To to_End
                 For sb = 0 To UBound(Suchbegriffe)
                     If LCase(.Cells(Zähler, 6).Value) Like Suchbegriffe(sb) Then Exit For
                 Next sb
                 If sb <= UBound(Suchbegriffe) Then lngAnzahl = lngAnzahl + 1
            Next Zähler
          
       End With
       
       Worksheets("Auswertung").Range("B4").Value = lngAnzahl
           
    End Sub
    Gruß Daniel

    Bild

    Betrifft: AW: VBA Zählen wenn Kriterien erfüllt Array
    von: Crizz
    Geschrieben am: 09.06.2015 14:05:10
    Hallo Daniel,
    danke für die Lösung. Könnte man deinen Array auch dynamisch befüllen lassen in dem man die Werte, wie bei der Lösung von Hary, aus einem Tabellenblatt herausliest?
    Viele Grüße Chris

    Bild

    Betrifft: AW: VBA Zählen wenn Kriterien erfüllt Array
    von: Daniel
    Geschrieben am: 09.06.2015 14:20:21
    Hi
    kannst du auch.
    dann mit folgenden Änderungen, wenn die suchbegriffe in Tabelle 1 in Spalte A untereinander stehen:
    Suchbegriffe = Sheets("Tabelle1").Range("A1").CurrentRegion.Value
    ...
    for sb = 1 to Ubound(Suchbegriffe, 1)
    If... Like "*" & Suchbegriffe(sb, 1) & "*" Then...
    ich gehe mal davon aus, dass du keine Sterne in der Liste eingebn willst und füge diese daher auch im Code hinzu.
    Wenn du das Array aus einem Zellbereich einliest, entsteht ein 2-Dimensionales Array mit dem Startindex 1 (vorher eindimensionales Array mit Startindex 0)
    beachte: es müssen mindeseten 2 Suchbegriffe in der Spalte A stehen (oder die Überschrift und mindestens ein Suchbegriff)
    wenn nur ein Wert da steht, erzeugt die Zuweisung kein Array sondern einen Einzelwert und der muss wieder anders programmiert werden.
    die Spalten links und rechts der Suchwerte müssen leer sein, ebenso die Zeile ober- und unterhalb.
    Gruß Daniel

    Bild

    Betrifft: AW: VBA Zählen wenn Kriterien erfüllt Array
    von: Crizz
    Geschrieben am: 10.06.2015 15:13:44
    Hi Daniel habe jetzt die Datei beigefügt damit du siehst wie ich es gemeint habe.
    https://www.herber.de/bbs/user/98126.xlsm
    Die Suchbegriffe stehen im Sheet "Suchbegriffe" und im Sheet "Auswertung" soll die jeweilige Anzahl der Suchbegriffe angezeigt werden. Mit dem aktuellen Code lässt sich die Spalten sowie Zeilenanzahl dynamisch erweitern/verringern allerdings Zählt es die Werte doppelt.
    Zu der von dir genannten Problemstellung, es können auch einzelne Werte vorkommen und die Dpalten rechts und links sind beschrieben ...
    Viele Grüße Chris

     Bild

    Beiträge aus den Excel-Beispielen zum Thema "VBA Zählen wenn Kriterien erfüllt Array"