Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: VBA Zählen wenn Kriterien erfüllt Array

VBA Zählen wenn Kriterien erfüllt Array
09.06.2015 07:47:23
Crizz
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

    Anzeige

    6
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: VBA Zählen wenn Kriterien erfüllt Array
    09.06.2015 08:45:45
    hary
    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

    Anzeige
    AW: VBA Zählen wenn Kriterien erfüllt Array
    09.06.2015 09:44:26
    Crizz
    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

    AW: VBA Zählen wenn Kriterien erfüllt Array
    09.06.2015 10:46:19
    Daniel
    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 
    Gruß Daniel

    Anzeige
    AW: VBA Zählen wenn Kriterien erfüllt Array
    09.06.2015 14:05:10
    Crizz
    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

    AW: VBA Zählen wenn Kriterien erfüllt Array
    09.06.2015 14:20:21
    Daniel
    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

    Anzeige
    AW: VBA Zählen wenn Kriterien erfüllt Array
    10.06.2015 15:13:44
    Crizz
    Hi Daniel habe jetzt die Datei beigefügt damit du siehst wie ich es gemeint habe.

    Die Datei https://www.herber.de/bbs/user/98126.xlsm wurde aus Datenschutzgründen gelöscht


    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
    Anzeige
    ;

    Forumthreads zu verwandten Themen

    Anzeige
    Anzeige
    Anzeige

    Infobox / Tutorial

    Zählen mit Bedingungen in Excel VBA: So geht's


    Schritt-für-Schritt-Anleitung

    1. Öffne die VBA-Entwicklungsumgebung: Drücke ALT + F11, um den VBA-Editor zu öffnen.
    2. Füge ein neues Modul hinzu: Klicke mit der rechten Maustaste auf "VBAProject (deine_Datei.xlsm)" und wähle "Einfügen" > "Modul".
    3. Kopiere den folgenden Code in das Modul:
    Sub Search()
        Dim Zähler As Long
        Dim to_End As Long
        Dim lngAnzahl As Long
        Dim Suchbegriffe As Variant
        Dim sb As Long
    
        '--- Suchbegriffe auflisten
        Suchbegriffe = Array("*ausrundung*", "*blend*") ' Hier kannst du deine Suchbegriffe anpassen
    
        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
                        lngAnzahl = lngAnzahl + 1
                        Exit For ' Verhindert doppeltes Zählen
                    End If
                Next sb
            Next Zähler
            Worksheets("Auswertung").Range("B4").Value = lngAnzahl
        End With
    End Sub
    1. Führe das Makro aus: Drücke F5, um das Makro auszuführen. Achte darauf, dass die Daten im "Datenblatt" stehen und die Auswertung im "Auswertung"-Blatt erfolgen soll.

    Häufige Fehler und Lösungen

    • Fehler: Doppelte Zählung von Einträgen

      • Lösung: Stelle sicher, dass Exit For im inneren Loop hinzugefügt wird, um eine doppelte Zählung zu vermeiden.
    • Fehler: Kein Ergebnis angezeigt

      • Lösung: Überprüfe, ob die Suchbegriffe korrekt in der Liste stehen und die Daten im angegebenen Bereich vorhanden sind.

    Alternative Methoden

    Eine alternative Methode zur Zählung von Zeilen mit Bedingungen wäre die Verwendung der COUNTIF-Funktion in Kombination mit VBA:

    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 Zähler
    End With

    Diese Methode ist besonders nützlich, wenn du eine Liste von Suchbegriffen in einem separaten Blatt hast.


    Praktische Beispiele

    • Beispiel 1: Zähle die Anzahl der Zeilen, die "Ausrundung" oder "blend" enthalten.
    • Beispiel 2: Dynamisches Einlesen von Suchbegriffen aus einem anderen Tabellenblatt:
    Suchbegriffe = Sheets("Suchbegriffe").Range("A1:A10").Value ' Anpassung an den Bereich

    Tipps für Profis

    • Nutze Arrays, um die Performance zu steigern, besonders bei großen Datenmengen.
    • Achte auf Klein- und Großschreibung: Verwende LCase, um alle Eingaben in Kleinbuchstaben zu konvertieren und so die Suche zu erleichtern.
    • Dynamische Listen: Erstelle eine dynamische Liste von Suchbegriffen, die sich automatisch anpasst, wenn du neue Begriffe hinzufügst oder entfernst.

    FAQ: Häufige Fragen

    1. Wie kann ich mehrere Bedingungen hinzufügen?
    Du kannst das Array mit weiteren Suchbegriffen erweitern, z.B. Suchbegriffe = Array("*ausrundung*", "*blend*", "*neuesWort*").

    2. Funktioniert dieser Code in allen Excel-Versionen?
    Ja, der Code sollte in Excel 2007 und neueren Versionen funktionieren. Stelle sicher, dass du die Makros aktiviert hast.

    3. Kann ich das Ergebnis in einer anderen Zelle anzeigen lassen?
    Ja, ändere einfach die Zeile Worksheets("Auswertung").Range("B4").Value = lngAnzahl auf die gewünschte Zielzelle.

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige