VBA - Countif Range stimmt mit mindestens einem Wert von Array

Question

überein

Ich weiß nicht, wie ich diese Aufgabe erledigen soll. Ich muss einen Bereich in einem Blatt zählen, wenn mindestens eines der Wörter in einer Zelle in diesem Bereich einem Array entspricht. Wenn z. B. Zelle "B2" einen Satz mit einem der Wörter enthält, die sich im Array befinden, zählt sie als Eins, und einfach countif ein Bereich, wenn sie mit einem Array übereinstimmt. Mein Code wird meine Frage besser anzeigen, also entschuldige ich mich, wenn das überhaupt verwirrend ist.

With ThisWorkbook 
    Dim Keywords As Variant 
    Dim iVal As Double 
    keyword = Array("*cold*", "*hot*", "*warm*", "*cool*", _ 
     "*temp*", "*thermostat*", "*heat*", "*temperature*", _ 
     "*not working*", "*see above*", "*broken*", "*freezing*", _ 
     "*warmer*", "*air conditioning*", "*humidity*", _ 
     "*humid*") 
    iVal=Application.WorksheetFunction.CountIf(Range("B2",Range("B2").End(xlDown)),keyword) 

    Dim rep As Worksheet 
    Set rep = Worksheets("Report") 
    rep.Range("A1") = iVal 
End With 

Wie ich zeigen, wenn eines dieser Wörter in dem Array Spiel in einer Zelle in dem Bereich definiert, Range("B2", Range("B2").End(xlDown)), dann zählen und Anzeigewert im Worksheets("Report").Range("A1"). Jede und jede Hilfe wird geschätzt, danke.

Answer 1

Sie müssen zwei Listen für Werte miteinander vergleichen - Ihre Range und die Array. Der einfachste Weg dazu ist eine verschachtelte Schleife. Wie folgt aus:

Sub TestMe() 

    With ThisWorkbook 

     Dim Keywords As Variant 
     Dim iVal  As Long 
     Dim myRange  As Range 
     Dim myCell  As Range 
     Dim bCount  As Boolean 
     Dim myVal  As Variant 

     keyword = Array("cold", "hot", "warm", "cool", _ 
         "temp", "thermostat", "heat", "temperature", _ 
         "not working", "see above", "broken", "freezing", _ 
         "warmer", "air conditioning", "humidity", _ 
         "humid") 

     Set myRange = Columns(2).SpecialCells(2) 

     For Each myCell In myRange 
      bCount = False 

      For Each myVal In keyword 
       If InStr(1, myCell, myVal, vbTextCompare) Then bCount = True 
      Next myVal 

      If bCount Then iVal = iVal + 1     
     Next myCell 

     Debug.Print iVal 
    End With 

End Sub 

Die Zählung erfolgt immer dann, wenn das Flag bCount-True gesetzt. Es wird bei jeder Iteration der äußeren Schleife auf False zurückgesetzt. Ich würde die * entfernen, soweit ich die InStr() verwende, um den Scheck zu machen, und die Sterne sind dort ein wenig nutzlos.

Außerdem gibt Columns(2).SpecialCells(2) einen Bereich zurück, der nur aus Werten besteht, die keine Formeln sind und in Spalte B nicht leer sind.

Answer 2

Das war meine Antwort ähnlich wie @Vityata. Beachten Sie, dass Sie seinen Vorschlag von SpecialCells verwenden können, um Leerzeichen zu ignorieren, wenn Sie den Bereich in das Array lesen.

Hinweis, es sucht nach "*Cold*", wenn das ist, was in dem Array ist. Setzen Sie einfach "Cold" usw. in das Array, wenn das Wort in der Zelle gesucht wird.

Option Explicit 

Public Sub test() 

    Dim Keywords As Variant 
    Dim iVal As Long 
    Dim wb As Workbook 
    Dim ws As Worksheet 

    Set wb = ThisWorkbook 
    Set ws = wb.Sheets(2) 

    Keywords = Array("*cold*", "*hot*", "*warm*", "*cool*", _ 
        "*temp*", "*thermostat*", "*heat*", "*temperature*", _ 
        "*not working*", "*see above*", "*broken*", "*freezing*", _ 
        "*warmer*", "*air conditioning*", "*humidity*", _ 
        "*humid*") 
    With ws 

     Dim rangetoCheck() 
     Dim counter1 As Long 
     Dim counter2 As Long 
     Dim totalCount As Long 
     iVal = 0 
     rangetoCheck = .Range("B2", .Range("B2").End(xlDown)).value 

     For counter1 = LBound(rangetoCheck, 1) To UBound(rangetoCheck, 1) 

      For counter2 = LBound(Keywords) To UBound(Keywords) 

       If InStr(1, rangetoCheck(counter1, 1), Keywords(counter2), vbBinaryCompare) Then 
        iVal = iVal + 1 
        Exit For 
       End If 

      Next counter2 

     Next counter1 

    End With 

    MsgBox iVal 

End Sub