合并VBA筛选脚本解决Excel列冲突及AutoFilter错误

问题背景 #

现有两个可正常运行的VBA脚本（FilterOut与FilterOut2），功能为读取Excel工作表某列字符串，筛选特定关键词后通过.Offset重命名单元格内容。具体逻辑是：识别设备列表中的Phones与Tablets，通过4G、5G、Cell关键词区分设备类型，将不含这些关键词的iPad和三星平板标记为Tablet。

现存问题 #

当前需对同一行的G列和P列同时校验，若G列符合条件但P列不符合，会出现判定冲突；且后运行的脚本会通过.Offset覆盖前一个脚本的结果，导致数据准确性受损。

需求 #

将两个脚本合并为一个，同时校验G、P列，把符合条件的行统一标记为Tablet，避免覆盖冲突。

尝试与错误 #

改写为FilterOut3脚本时，出现错误提示：错误：对象变量或With块变量未设置，错误指向.AutoFilter field:=1, criteria1:=arrResult, Operator:=xlFilterValues行。

错误原因：脚本中声明了rg变量但未执行Set rg = ...赋值操作，导致With rg块调用时变量未初始化；同时原脚本仅校验了G列，未实现G、P列同时校验的需求。

原有脚本 #

FilterOut（校验G列）

Sub FilterOut()

'在G列中查找所有不含4G、5G、Cell的iPad和三星平板，标记为Tablet
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Full Asset List")

Dim lastRow As Long
lastRow = ws.Range("G" & ws.Rows.Count).End(xlUp).Row

Dim arr(): Dim arrResult()
Dim rg As Range: Dim i As Long

Set rg = ws.Range("G1:G" & lastRow)
arr = Application.Transpose(rg)

For i = LBound(arr) To UBound(arr)
    If InStr(arr(i), "SAMSUNG TABLET") <> 0 Or InStr(arr(i), "IPAD") <> 0 Or InStr(arr(i), "ipad") <> 0 Then
        If InStr(arr(i), "64GB") <> 0 Then arr(i) = Replace(arr(i), "64GB", "!@!")
            If InStr(arr(i), "*CELL*") = 0 And InStr(arr(i), "*cell*") = 0 And InStr(arr(i), "4G") = 0 And InStr(arr(i), "5G") = 0 Then
                If InStr(arr(i), "!@!") <> 0 Then arr(i) = Replace(arr(i), "!@!", "64GB")
                j = j + 1
                ReDim Preserve arrResult(1 To j)
                arrResult(j) = arr(i)
            End If
    End If
Next i

With rg
    .AutoFilter field:=1, criteria1:=arrResult, Operator:=xlFilterValues
    .Resize(.Rows.Count - 1, 1).Offset(1, -2).Value = "Tablet"
    .Resize(.Rows.Count - 1, 1).Offset(1, -3).Value = "Tablet"
End With

    ws.AutoFilterMode = False

End Sub

FilterOut2（校验P列）

Sub FilterOut2()

'在P列中查找所有不含4G、5G、Cell的iPad，标记为Tablet
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Full Asset List")

Dim lastRow As Long
lastRow = ws.Range("P" & ws.Rows.Count).End(xlUp).Row

Dim arr(): Dim arrResult()
Dim rg As Range: Dim i As Long

Set rg = ws.Range("P1:P" & lastRow)
arr = Application.Transpose(rg)

For i = LBound(arr) To UBound(arr)
    If InStr(arr(i), "IPAD") <> 0 Or InStr(arr(i), "ipad") <> 0 Then
        If InStr(arr(i), "64GB") <> 0 Then arr(i) = Replace(arr(i), "64GB", "!@!")
            If InStr(arr(i), "CELL") = 0 And InStr(arr(i), "cell") = 0 And InStr(arr(i), "4G") = 0 And InStr(arr(i), "5G") = 0 Then
                If InStr(arr(i), "!@!") <> 0 Then arr(i) = Replace(arr(i), "!@!", "64GB")
                j = j + 1
                ReDim Preserve arrResult(1 To j)
                arrResult(j) = arr(i)
            End If
    End If
Next i

With rg
    .AutoFilter field:=1, criteria1:=arrResult, Operator:=xlFilterValues
    .Resize(.Rows.Count - 1, 1).Offset(1, -11).Value = "Tablet"
    .Resize(.Rows.Count - 1, 1).Offset(1, -12).Value = "Tablet"
End With

    ws.AutoFilterMode = False

End Sub

错误脚本FilterOut3 #

Sub FilterOut3()

Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Full Asset List")

Dim lastRow As Long
lastRow = ws.Range("P" & ws.Rows.Count).End(xlUp).Row

Dim arr(): Dim arrResult()
Dim rg As Range: Dim i As Long

arr = ws.Range("G1:P" & lastRow).Value

'arr = Application.Transpose(rg)

For i = LBound(arr) To UBound(arr)
    If InStr(arr(i, 1), "IPAD") <> 0 Or InStr(arr(i, 1), "ipad") <> 0 Then
        If InStr(arr(i, 1), "64GB") <> 0 Then arr(i, 1) = Replace(arr(i, 1), "64GB", "!@!")
            If InStr(arr(i, 1), "CELL") = 0 And InStr(arr(i, 1), "cell") = 0 And InStr(arr(i, 1), "4G") = 0 And InStr(arr(i, 1), "5G") = 0 Then
                If InStr(arr(i, 1), "!@!") <> 0 Then arr(i, 1) = Replace(arr(i, 1), "!@!", "64GB")
                j = j + 1
                ReDim Preserve arrResult(1 To j)
                arrResult(j) = arr(i, 1)
            End If
    End If
Next i

With rg
    .AutoFilter field:=1, criteria1:=arrResult, Operator:=xlFilterValues
    .Resize(.Rows.Count - 1, 1).Offset(1, -11).Value = "Tablet"
    .Resize(.Rows.Count - 1, 1).Offset(1, -12).Value = "Tablet"
End With

    ws.AutoFilterMode = False

End Sub

错误提示：

错误：对象变量或With块变量未设置

.AutoFilter field:=1, criteria1:=arrResult, Operator:=xlFilterValues

修复后的脚本FilterOutFinal #

Sub FilterOutFinal()
    '同时校验G列和P列，标记符合条件的设备为Tablet
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Sheets("Full Asset List")
    
    Dim lastRow As Long
    '取G列和P列中最大的行号，避免遗漏数据
    lastRow = Application.Max(ws.Range("G" & ws.Rows.Count).End(xlUp).Row, _
                             ws.Range("P" & ws.Rows.Count).End(xlUp).Row)
    
    Dim arrData As Variant
    '读取G到P列的所有数据
    arrData = ws.Range("G1:P" & lastRow).Value
    
    Dim i As Long
    Dim isTablet As Boolean
    
    '遍历每一行数据
    For i = LBound(arrData, 1) To UBound(arrData, 1)
        isTablet = False
        
        '校验G列：是否是三星平板或iPad，且不含4G/5G/Cell
        If (InStr(LCase(arrData(i, 1)), "samsung tablet") > 0 Or _
            InStr(LCase(arrData(i, 1)), "ipad") > 0) Then
            If InStr(LCase(arrData(i, 1)), "cell") = 0 And _
               InStr(arrData(i, 1), "4G") = 0 And _
               InStr(arrData(i, 1), "5G") = 0 Then
                isTablet = True
            End If
        End If
        
        '如果G列不符合，校验P列：是否是iPad，且不含4G/5G/Cell
        If Not isTablet Then
            If InStr(LCase(arrData(i, 10)), "ipad") > 0 Then 'P列是第10列（G是第1列，G到P共10列）
                If InStr(LCase(arrData(i, 10)), "cell") = 0 And _
                   InStr(arrData(i, 10), "4G") = 0 And _
                   InStr(arrData(i, 10), "5G") = 0 Then
                    isTablet = True
                End If
            End If
        End If
        
        '如果符合条件，标记对应单元格（原脚本中Offset的位置：G列偏移-2是E列，-3是D列；P列偏移-11是E列，-12是D列，统一操作D、E列）
        If isTablet And i > 1 Then '跳过表头行
            ws.Cells(i, "D").Value = "Tablet"
            ws.Cells(i, "E").Value = "Tablet"
        End If
    Next i
End Sub

修复说明 #

1. 解决原错误：移除依赖AutoFilter的逻辑，改用数组遍历直接操作单元格，避免未初始化rg变量的问题；
2. 合并校验逻辑：同时检查同一行的G列和P列，只要其中一列符合条件就标记为Tablet；
3. 优化判定逻辑：使用LCase()统一转换为小写，避免大小写匹配问题；
4. 避免覆盖冲突：直接定位到D、E列赋值，无需依赖.Offset，确保操作准确性；
5. 鲁棒性提升：取G、P列最大行号，避免因某列数据行数少导致遗漏。

内容的提问来源于stack exchange，提问作者TomTK