修改VBA代码：实现A匹配G、B与I为空的匹配值写入E列

需求说明 #

需要在E列输出同时满足以下条件的门店位置：

• G列中存在与A列相同的门店位置
• A列对应行的B列是空值（含空字符串）
• G列匹配行的I列是空值（含空字符串）

修改后的VBA代码 #

Sub ListMatchesInE()
    Dim ws As Worksheet
    Dim lastRowA As Long, lastRowG As Long
    Dim i As Long, pasteRow As Long
    Dim valA As Variant
    Dim valB As Variant
    Dim matchCell As Range
    
    Set ws = ThisWorkbook.ActiveSheet
    
    ' 获取A列和G列的最后一行
    lastRowA = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    lastRowG = ws.Cells(ws.Rows.Count, 7).End(xlUp).Row
    
    ' 清空E列原有结果
    ws.Range("E2:E" & ws.Rows.Count).ClearContents
    
    pasteRow = 2
    
    For i = 2 To lastRowA
        valA = ws.Cells(i, 1).Value ' 读取A列门店位置
        valB = ws.Cells(i, 2).Value ' 读取B列状态
        
        ' 检查B列是否为真正的空值（排除错误值，去除空格后长度为0）
        If Not IsError(valB) And Len(Trim(valB)) = 0 Then
            ' 在G列查找匹配的门店位置
            Set matchCell = ws.Range("G2:G" & lastRowG).Find(What:=valA, LookIn:=xlValues, LookAt:=xlWhole)
            ' 如果找到匹配项，且对应I列为空
            If Not matchCell Is Nothing Then
                If Len(Trim(matchCell.Offset(0, 2).Value)) = 0 Then ' Offset(0,2)指向G列右侧第2列即I列
                    ws.Cells(pasteRow, 5).Value = valA
                    pasteRow = pasteRow + 1
                End If
            End If
        End If
    Next i
End Sub

代码修改说明 #

1. 新增matchCell变量定位G列匹配单元格，替代原CountIf仅判断存在性的逻辑，实现对匹配行I列状态的检查
2. 使用Find方法精准匹配G列完整门店名称，避免部分匹配的误判
3. 通过Offset(0,2)获取匹配行的I列单元格，验证其是否为空值（去除空格后长度为0）
4. 仅当三个条件同时满足时，才将门店位置写入E列

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