VBA：InStr“ OR”问题

Question

我的InStr“ OR”代码有问题。 这段代码： If InStr(items, "harmo") Or InStr(items, "pointt") Then count_of_Harmo = count_of_Harmo + 1可以很好地执行（下面以红色突出显示），但是这不是ElseIf InStr(items, "addi") Or InStr(items, "add-i") Or InStr(items, "plug") Then count_of_Addi = count_of_Addi + 1 （下面以蓝色突出显示）。 请不要介意下图中的其他结果/计数，因为我无法捕获整个页面，因为我认为它与案例有关。 请参见下面的完整代码。 谢谢。

Option Compare Text

Public Sub Keywords_Outlook()

Dim row_number As Long
Dim count_of_Harmo As Long
Dim count_of_Room As Long
Dim count_of_Skyp As Long
Dim count_of_Detach As Long
Dim count_of_Wire As Long
Dim count_of_Addi As Long
Dim count_of_crash As Long
Dim count_of_share As Long
Dim count_of_signa As Long
Dim count_of_passw As Long
Dim count_of_follo_and_ops As Long
Dim count_of_follo_and_req As Long
Dim count_of_others As Long
Dim items As Variant
Dim cursht As String 'for the macro to run in any sheet
cursht = ActiveSheet.Name 'for the macro to run in any sheet

row_number = 1
count_of_Harmo = 0
count_of_Room = 0
count_of_Skyp = 0
count_of_Detach = 0
count_of_Wire = 0
count_of_Addi = 0
count_of_crash = 0
count_of_share = 0
count_of_signa = 0
count_of_passw = 0
count_of_follo_and_ops = 0
count_of_follo_and_req = 0
count_of_others = 0
count_of_all = 0

Do

row_number = row_number + 1
items = Sheets(cursht).Range("N" & row_number)

    If InStr(items, "harmo") Or InStr(items, "pointt") Then
        count_of_Harmo = count_of_Harmo + 1
    ElseIf InStr(items, "room") Then
        count_of_Room = count_of_Room + 1
    ElseIf InStr(items, "skyp") Then
        count_of_Skyp = count_of_Skyp + 1
    ElseIf InStr(items, "detach") Then
        count_of_Detach = count_of_Detach + 1
    ElseIf InStr(items, "wire") Then
        count_of_Wire = count_of_Wire + 1
    ElseIf InStr(items, "addi") Or InStr(items, "add-i") Or InStr(items, "plug") Then
        count_of_Addi = count_of_Addi + 1
    ElseIf InStr(items, "crash") Or InStr(items, "car") Then
        count_of_crash = count_of_crash + 1
    ElseIf InStr(items, "share") Then
        count_of_share = count_of_share + 1
    ElseIf InStr(items, "signa") Then
        count_of_signa = count_of_signa + 1
    ElseIf InStr(items, "passw") Then
        count_of_passw = count_of_passw + 1
    ElseIf Trim(items) Like "*followu*" And Trim(items) Like "*ops*" Then
        count_of_follo_and_ops = count_of_follo_and_ops + 1
    ElseIf Trim(items) Like "*followu*" And Trim(items) Like "*req*" Then
        count_of_follo_and_req = count_of_follo_and_req + 1

    ElseIf items <> "" Then
        count_of_others = count_of_others + 1
    End If

Loop Until items = ""

count_of_all = count_of_Harmo + count_of_Room + count_of_Skyp + count_of_Detach + count_of_Wire + count_of_Addi + count_of_crash + count_of_signa + count_of_passw + count_of_follo_and_ops + count_of_follo_and_req + count_of_others

Range("N2").Select


Selection.End(xlDown).Select
lastCell = ActiveCell.Address

ActiveCell.Offset(3, 0).Value = "Count"
ActiveCell.Offset(4, 0).Value = count_of_Harmo
ActiveCell.Offset(5, 0).Value = count_of_Room
ActiveCell.Offset(6, 0).Value = count_of_Skyp
ActiveCell.Offset(7, 0).Value = count_of_Detach
ActiveCell.Offset(8, 0).Value = count_of_Wire
ActiveCell.Offset(9, 0).Value = count_of_Addi
ActiveCell.Offset(10, 0).Value = count_of_crash
ActiveCell.Offset(11, 0).Value = count_of_share
ActiveCell.Offset(12, 0).Value = count_of_signa
ActiveCell.Offset(13, 0).Value = count_of_passw
ActiveCell.Offset(14, 0).Value = count_of_follo_and_ops
ActiveCell.Offset(15, 0).Value = count_of_follo_and_req
ActiveCell.Offset(16, 0).Value = count_of_others
ActiveCell.Offset(18, 0).Value = count_of_all
ActiveCell.Offset(3, 1).Value = "Outlook Keywords"
ActiveCell.Offset(4, 1).Value = "Harmo"
ActiveCell.Offset(5, 1).Value = "Room"
ActiveCell.Offset(6, 1).Value = "Skyp"
ActiveCell.Offset(7, 1).Value = "Detach"
ActiveCell.Offset(8, 1).Value = "Wire"
ActiveCell.Offset(9, 1).Value = "Addi or add-i or plug"
ActiveCell.Offset(10, 1).Value = "Crash"
ActiveCell.Offset(11, 1).Value = "Share"
ActiveCell.Offset(12, 1).Value = "Signa"
ActiveCell.Offset(13, 1).Value = "passw"
ActiveCell.Offset(14, 1).Value = "FollowU and ops"
ActiveCell.Offset(15, 1).Value = "FollowU and req"
ActiveCell.Offset(16, 1).Value = "Others"
ActiveCell.Offset(18, 1).Value = "Total"
ActiveCell.Offset(3, -1).Value = "Percent"
ActiveCell.Offset(4, -1).Value = count_of_Harmo / count_of_all
ActiveCell.Offset(5, -1).Value = count_of_Room / count_of_all
ActiveCell.Offset(6, -1).Value = count_of_Skyp / count_of_all
ActiveCell.Offset(7, -1).Value = count_of_Detach / count_of_all
ActiveCell.Offset(8, -1).Value = count_of_Wire / count_of_all
ActiveCell.Offset(9, -1).Value = count_of_Addi / count_of_all
ActiveCell.Offset(10, -1).Value = count_of_crash / count_of_all
ActiveCell.Offset(11, -1).Value = count_of_share / count_of_all
ActiveCell.Offset(12, -1).Value = count_of_signa / count_of_all
ActiveCell.Offset(13, -1).Value = count_of_passw / count_of_all
ActiveCell.Offset(14, -1).Value = count_of_follo_and_ops / count_of_all
ActiveCell.Offset(15, -1).Value = count_of_follo_and_req / count_of_all
ActiveCell.Offset(16, -1).Value = count_of_others / count_of_all


End Sub

Answer 1

在整个If/ElseIf语句中，只有在所有前面的分支都没有执行的情况下，每个分支才能执行。

蓝色圈出的单元格触发了Harmo分支，并且无法触发任何其他分支。

如果您不希望发生这种情况，请将每个分支设为单独的If/End If语句。

附带说明，您应该考虑在所有情况下将InStr的结果显式比较为零。 它之所以能够正常工作，是因为您仅使用Or ，但是如果您决定使条件更加复杂，则可能会停止工作 。

Answer 2

查看您的代码，可以找到更高效，更短的代码。

用Select Case切换多个ElseIf ，而不是拥有14个计数器，为什么不使用一个计数器数组CountofArr ？

参见下面的示例代码，您可以轻松地继续实施：

Option Compare Text

Public Sub Keywords_Outlook()

Dim row_number As Long, LastRow As Long

' use an array that will have multiple counters
Dim CountofArr() As Long

ReDim CountofArr(0 To 14)

Dim items As Variant
Dim cursht As String 'for the macro to run in any sheet

cursht = ActiveSheet.Name ' for the macro to run in any sheet

With Sheets(cursht)
    LastRow = .Cells(.Rows.Count, "N").End(xlUp).Row ' get last row with data in column "N"

    For row_number = 1 To LastRow
        items = .Range("N" & row_number).Value2

        Select Case True
            Case items Like "*harmo*", items Like "*pointt*"
                CountofArr(0) = CountofArr(0) + 1

            Case items Like "*room*"
                CountofArr(1) = CountofArr(1) + 1

            ' add the rest of your cases below


        End Select
    Next row_number

    ' read the array direclty to the cells
    For row_number = 4 To 18
        .Range("O" & row_number).Value = CountofArr(row_number - 4)
    Next row_number

    ' rest of your code

End With

End Sub