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
