作者：未知 来源：月光软件站 加入时间：2005-5-13　月光软件站

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

相关软件：