诀窍是要有一个内部循环，该循环在从工作表单元格获得的数组上进行迭代。

Option Explicit

Sub try_to_find_text()
Dim ALCell As Range
Dim car As Integer
Dim van As Integer
Dim truck As Integer
Dim digger As Integer



    For Each ALCell In ActiveSheet.Range("E21:E1000")
    
        Dim myVehicle As Variant
        Dim myVehicles As Variant
        myVehicles = TriageToArray(ALCell.Value,",")
        For Each myVehicle In myVehicles
        
            Select Case myVehicle
            
                Case Is = "car"
                
                    car = car + 1  
     
                Case Is = "van"

                    van = van + 1
                
                Case Is = "truck"

                    truck = truck + 1
                
                Case Is = "digger"

                    HCAS = HCAS + 1
                  
                Case Is = ""
                       
            End Select
            
        Next

Next ALCell

ActiveSheet.Range("B13").Value = car
ActiveSheet.Range("C13").Value = van
ActiveSheet.Range("D13").Value = truck
ActiveSheet.Range("E13").Value = digger
End Sub


Public Function TriageToArray(ByVal ipString As String, Optional ByVal ipSeparator As String = " ") As Variant

    Dim myArray As Variant
    myArray = Split(ipString, ipSeparator)
    
    Dim myIndex As Long
    For myIndex = LBound(myArray) To UBound(myArray)
    
        myArray(myIndex) = LCase$(Trim$(myArray(myIndex)))
        
    Next

    TriageToArray = myArray
    
End Function