Excel VBA如何排除含指定关键词的行计算U列平均值

问题描述 #

计算Excel中U列的平均值，但需排除C列包含特定关键词的行。当前通过指定完整文本排除行，长文本导致代码冗余，希望改用关键词（如“Makro”或“Seas”）匹配的方式简化代码。

当前使用的代码：

Dim ws As Worksheet
Set ws = Worksheets("mapa_cargas") 'Worksheets("mapa_cargas")
    
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.count, "U").End(xlUp).Row
    
Dim arr, arrAV, i As Variant, k As Long
arr = ws.Range("C1:U" & lastRow).Value2 'place the range in an array for faster processing
ReDim arrAV(UBound(arr) - 1) 'redim the average array of a maximum


    For i = 1 To UBound(arr)
        ' Check if the current array row contains a value to exclude
        If arr(i, 1) <> "Seven Seas Maritime Services Portug" And arr(i, 3) <> "" And arr(i, 17) <> "PC" And arr(i, 19) > "" Then

            arrAV(k) = arr(i, 19): k = k + 1 'place the matching values in the array
        End If
    Next i

    If k > 0 Then
        ReDim Preserve arrAV(k - 1) 'eliminate the empty array elements
        Worksheets("indicadores").Cells(4, 7).Value = Format(WorksheetFunction.average(arrAV), "hh:mm:ss")
    Else
        MsgBox "No values existing to make average on Espera...": Exit Sub
    End If

解决方案 #

利用VBA的InStr函数检测文本中是否包含指定关键词，同时将关键词存入数组，便于后续扩展（新增关键词只需修改数组内容）。

修改后的代码：

Dim ws As Worksheet
Set ws = Worksheets("mapa_cargas")
    
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "U").End(xlUp).Row
    
Dim arr, arrAV, excludeKeywords As Variant
Dim i As Long, k As Long, isExcluded As Boolean

' 定义需要排除的关键词数组，新增关键词直接添加到数组中
excludeKeywords = Array("Makro", "Seas")

arr = ws.Range("C1:U" & lastRow).Value2
ReDim arrAV(UBound(arr) - 1)

For i = 1 To UBound(arr)
    isExcluded = False
    
    ' 循环检测当前行C列是否包含任意排除关键词
    For Each keyword In excludeKeywords
        If InStr(1, arr(i, 1), keyword, vbTextCompare) > 0 Then
            isExcluded = True
            Exit For
        End If
    Next keyword
    
    ' 未被排除且满足其他条件时，将U列值加入计算数组
    If Not isExcluded And arr(i, 3) <> "" And arr(i, 17) <> "PC" And arr(i, 19) <> "" Then
        arrAV(k) = arr(i, 19)
        k = k + 1
    End If
Next i

If k > 0 Then
    ReDim Preserve arrAV(k - 1)
    Worksheets("indicadores").Cells(4, 7).Value = Format(WorksheetFunction.Average(arrAV), "hh:mm:ss")
Else
    MsgBox "No values existing to make average on Espera...": Exit Sub
End If

关键修改说明 #

• 关键词数组：将排除关键词存入excludeKeywords数组，新增或修改关键词只需调整数组内容，无需修改判断逻辑，提升代码扩展性。
• InStr函数：InStr(1, arr(i, 1), keyword, vbTextCompare)用于检测C列文本（arr(i,1)）是否包含指定关键词，vbTextCompare表示不区分大小写匹配，若需要区分大小写可改用vbBinaryCompare。
• 排除标记：通过isExcluded变量标记当前行是否需要排除，逻辑更清晰。

内容的提问来源于stack exchange，提问作者André Lopes