Sub Match() '根据表2中的记录在表1中找近似匹配,并在后面做标记 Dim i As Long, j As Long, p As Long, q As Long i = Application.WorksheetFunction.CountA(Sheet1.Range("b:b")) '表1的行数,根据b列决定 j = Application.WorksheetFunction.CountA(Sheet2.Range("a:a")) '表2的行数,根据a列决定 If i > 1 And j > 0 Then Sheet1.Range("h2:h" & i).Value = "*" '先在后面的空白列中做标记* For p = 1 To j '遍历表2中的内容 Sheet1.Activate '筛选出包含对应内容的记录 ActiveSheet.Range("$A$1:$G$" & i).AutoFilter Field:=5, Criteria1:="=*" & Sheet2.Range("a" & p).Value & "*" '筛选后的处理,清空* Columns("H:H").Select Selection.ClearContents Selection.AutoFilter Next p End If End Sub