求Excel宏：基于F列列表匹配C列内容，为对应D列单元格填1

以下是实现需求的VBA代码，可完成C列内容与F列列表的完全/部分匹配检查，并在对应D列标记"1"：

Sub MarkMatchingItems()
    Dim ws As Worksheet
    Dim cRange As Range, fRange As Range
    Dim fArr As Variant
    Dim i As Long, matchFound As Boolean
    
    ' 指定操作的工作表，可替换为具体表名如Sheets("Sheet1")
    Set ws = ActiveSheet
    
    ' 获取C列和F列的有效数据区域（跳过表头，假设表头在第1行）
    Set cRange = ws.Range("C2:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)
    Set fRange = ws.Range("F2:F" & ws.Cells(ws.Rows.Count, "F").End(xlUp).Row)
    
    ' 将F列数据存入数组，提升遍历效率
    fArr = fRange.Value
    
    ' 遍历C列每个单元格
    For Each cCell In cRange
        matchFound = False
        ' 遍历F列的匹配项数组
        For i = LBound(fArr) To UBound(fArr)
            ' 检查C列单元格是否包含当前F列条目（不区分大小写）
            If InStr(1, cCell.Value, fArr(i, 1), vbTextCompare) > 0 Then
                matchFound = True
                Exit For ' 找到匹配立即终止内层循环
            End If
        Next i
        
        ' 设置D列对应单元格的值
        cCell.Offset(0, 1).Value = IIf(matchFound, 1, "")
    Next cCell
    
    MsgBox "匹配标记完成！", vbInformation
End Sub

代码说明 #

• 范围获取：自动识别C列和F列的有效数据行，避免遍历空单元格
• 效率优化：将F列数据存入数组，减少对工作表单元格的重复读取，数据量大时优势明显
• 匹配规则：使用InStr函数检查包含关系，完全匹配是部分匹配的特例，无需额外处理；参数vbTextCompare表示不区分大小写，如需区分可删除该参数
• 结果处理：匹配成功则D列填"1"，未匹配则清空对应单元格（可改为填0，只需把""替换为0）

使用方法 #

1. 打开目标Excel文件，按下Alt+F11打开VBA编辑器
2. 右键点击左侧的工作簿名称，选择「插入」→「模块」
3. 将上述代码粘贴到模块窗口中
4. 返回Excel界面，按下Alt+F8，选择MarkMatchingItems宏并执行

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