如何在单元格中搜索文本，单元格中可能有多个值

Question

我正在尝试制作和自动报告搜索文本的单元格，并将它们转换为值。所以一个细胞可能有车，货车，车，卡车，下一个细胞可能只有车。

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")
    
        Select Case ALCell.Value
        
            Case Is <> ""
            
                        Dim Search1, Where1
                        Search1 = "car"
                        Where1 = InStr(ActiveCell.Text, Search1)
                            If Where1 Then
                                car = car + 1
                           
                            End If
            
            
            Case Is = "van"
            van = van + 1
            
            Case Is = "truck"
            truck = truck + 1
            
            Case Is = "digger"
            HCAS = HCAS + 1
            
          
            Case Is = ""
        
           
        
        End Select

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

上面的代码将找到在"“中具有特定值的单元格，但是如果有更多的单元格，例如car，van，这将在计数中遗漏。在顶部，我试图为活动的单元格文本创建一个循环，但这不起作用，任何帮助都会有帮助。谢谢

Answer 1

诀窍是有一个内部循环，它迭代从工作表单元格获得的数组。

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