Question

我在工作表（称为MainDump）中有大量数据。我有一个程序可以评估此列表，并使用以下设置返回某些值：

Dim ws1 As Worksheet
Set ws1 = Worksheets("DashBoard")
Dim ws2 As Worksheet
Set ws2 = Worksheets("MainDump")
Dim cntr As Long

On Error GoTo ErrorHandler 'Got A lot of divide by zero errors if searchstring wasn't found
With Application.WorksheetFunction            
    ws1.Range("O4").Value = .CountIf(ws2.Range("E:E"), "*" & "CEOD" & "*")
    ws1.Range("L4").Value = .CountIfs(ws2.Range("E:E"), "*" & "CEOD" & "*", ws2.Range("A:A"), "Yes") / ws1.Range("O4").Value
    ws1.Range("M4").Value = .CountIfs(ws2.Range("E:E"), "*" & "CEOD" & "*", ws2.Range("B:B"), "Yes") / ws1.Range("O4").Value
    ws1.Range("N4").Value = .CountIfs(ws2.Range("E:E"), "*" & "CEOD" & "*", ws2.Range("C:C"), "SA Present, WBDA Present") / ws1.Range("O4").Value
End With
cntr = cntr + 1        
'^This proces is then copied and thus repeated a total of 76 times, as I want to check 
'for 76 different values in ws2.Range("E:E"), resulting in a massive code

ErrorHandler:
If Err.Number = 6 Then
    If ws1.Range("O" & cntr).Value = 0 Then
        ws1.Range("L" & cntr).Value = "div. by zero"
        ws1.Range("M" & cntr).Value = "div. by zero"
        ws1.Range("N" & cntr).Value = "div. by zero"
    End If
End If
Resume Next

我在VBA经验不足的时候写了这篇文章。不用说此代码需要花费很多时间才能完成（Maindump大约需要98000行）。所以我想尝试通过数组来完成这项工作。

我的方法是为我要检入数组索引的每个字符串定义一个计数器，然后遍历数组，并在数组中找到字符串时递增相应的计数器。我的问题是是否可以采用以下形式编写该循环：

Dim LastRow1 As long
Dim DataArray() As Variant
Dim SearchString1, SearchString2, .... SearchString76 As String
Dim SearchString1Cntr, SearchString2Cntr, .... SearchString76Cntr As long

With ws2
    LastRow1 = .Cells.Find(What:="*", After:=.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row 'Gets the total row amount in the sheet
    DataArray = .Range("A3:E" & LastRow1) 'puts selected range in Array
End With

For LastRow1 = Lbound(DataArray, 1) to Ubound(DataArray, 1)
    'Start a For Each loop to check for all 76 strings
    If Instr(1, DataArray(LastRow1, 5), SearchString > 0 Then 'SearchString is found so then
        SearchStringCntr1 = SearchStringcntr1 + 1 
'Where SearchStrinCntr1 is the counter related to the string checked for in the loop, 
'so it switches when the SearchString changes
    End If
   'Next SearchString to check
Next LastRow1

因此，我想尝试在For Next循环中使用灵活的If语句，该语句检查每个SearchString的数组索引，然后在循环到下一个索引之前，如果在索引中找到了SearchString，则递增相应的SearchStringCntr。这可能吗？我想防止为每个SearchString + StringCntr制作76个不同的If / ElseIf语句，然后在每次代码循环遍历For LastRow1 / Next LastRow1循环时使用计数器来遍历它们。很想听听您的意见。

Answer 1

也许这会有所帮助（可能需要进行一些调整）。
在工作簿中的某个地方创建命名范围“ Strings”，您将在其中存储所有要查找的字符串

Option Explicit

Sub StringsCompare()

    Dim LastRow1 As Long
    Dim DataArray() As Variant, StringArray() As Variant
    Dim Ws2 As Worksheet
    Dim CompareStringsNo As Long, StringCounter As Long
    Dim i As Long, j As Long
    Dim aCell As Range
    Dim SourceStr As String, SearchStr As String

    Set Ws2 = ThisWorkbook.Sheets("Sheet1")
    StringCounter = 1

    With Ws2
        'fill array with your strings to compare
        CompareStringsNo = .Range("Strings").Rows.Count
        ReDim StringArray(1 To CompareStringsNo, 1 To 2)
        For Each aCell In .Range("Strings")
            StringArray(StringCounter, 1) = aCell.Value
            StringCounter = StringCounter + 1
        Next aCell

        'fill data array
        LastRow1 = .Cells.Find(What:="*", After:=.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row 'Gets the total row amount in the sheet
        DataArray = .Range("A1:E" & LastRow1)
    End With

    'search data array
    For i = LBound(DataArray, 1) To UBound(DataArray, 1)
        SourceStr = DataArray(i, 5)
        'search array with your strings
        For j = LBound(StringArray) To UBound(StringArray)
            SearchStr = StringArray(j, 1)
            If InStr(1, SourceStr, SearchStr) > 0 Then
                'if match is found increase counter in array
                StringArray(j, 2) = StringArray(j, 2) + 1
                'you can add exit for here if you want only first match
            End If
        Next j
    Next i

    For i = LBound(StringArray) To UBound(StringArray)
        Debug.Print StringArray(i, 1) & " - " & StringArray(i, 2)
    Next i

End Sub

Answer 2

我认为主要任务过于复杂。

要检查字符串在数组中出现多少次，可以使用以下函数：

Function OccurWithinArray(theArray As Variant, stringToCount As String) As Long
    Dim strArr As String
    strArr = Join(theArray, " ")
    OccurWithinArray = (Len(strArr) - Len(Replace(strArr, stringToCount, _
        vbNullString, , , vbTextCompare))) / Len(stringToCount)
End Function

...和演示：

Sub Demo()
    Dim test(1 To 3) As String
    test(1) = "I work at the Dog Pound."
    test(2) = "I eat dogfish regularly."
    test(3) = "Steroidogenesis is a thing."
    Debug.Print OccurWithinArray(test, "dog")
End Sub

工作原理：

Join将数组的所有元素连接成一个大字符串。 Len返回文本的长度。
Replace临时替换删除所有出现的搜索词。
Len返回文本的“修改”长度。
两个Len之间的差除以要搜索的字符串的长度，就是整个数组中该字符串出现的次数。

这将返回3，因为搜索是区分大小写的（ in ）。

要使搜索区分大小写，请删除单词vbTextCompare（在这种情况下，此示例将返回2。）

根据数组索引值增加不同的计数器

2 个答案: