Sub USEMATCH() Dim s_p As String, e_p As String Dim num As Integer num = 0 For Each M In Range("a:a") If M.Value <> "" Then num = num + 1 Else Exit For End If Next M erange = "b" & num erange = "b2:" & erange N = 1 a = 2 currange = "b" & a Cells.Select Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _ , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _ xlSortNormal, DataOption2:=xlSortNormal Columns("A:A").Select Selection.Insert Shift:=xlToRight '最左插入一列 Set curCell = Worksheets(Sheets(1).Name).Range(currange) For Each M In Range(erange) On Error GoTo ErrorHandler If M.Offset(0, -1).Value <> "" Then GoTo mynext If M.Offset(0, 1).Value = "" Then GoTo mynext '当前单元格左不为空/右单元格内容为空则转 s_p = M.Value: e_p = M.Offset(0, 1).Value pos = Application.WorksheetFunction.Match(e_p, Worksheets(1).Range(erange), 0) '查找终点在起点列出现的行数 If pos = "" Then curCell.Offset(0, -1).Value = "NO" GoTo mynext '若没有找到则设为"no" End If thenext: Position = "B" & Trim(Str(pos)) '定位到所在单元格 If Range(Position).Offset(0, 1).Value = s_p Then If Range(Position).Offset(0, -1) = "" Then '若符合条件则在对应记录前标记 curCell.Offset(0, -1).Value = N & ".A" Range(Position).Offset(0, -1).Value = N & ".B" N = N + 1 Else curCell.Offset(0, -1).Value = "NO" End If Else If Range(Position).Offset(1, 0).Value = e_p Then pos = pos + 1 GoTo thenext Else curCell.Offset(0, -1).Value = "NO" End If End If myVar = 0 mynext: a = a + 1 currange = "b" & a Set curCell = Worksheets(Sheets(1).Name).Range(currange) Next ErrorHandler: curCell.Offset(0, -1).Value = "NO" Resume Next End Sub 表格形式为:A列 和B列. 匹配条件是:按行查询,若第一行的A列单元格内容等于另一行B列单元格内容,就检查第一行B列单元格内容是否等于另一行A列单元格内容,若相等就在这两行前做标记.否则标记为NO 
|