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 '當(dāng)前單元格左不為空/右單元格內(nèi)容為空則轉(zhuǎn)
s_p = m.value: e_p = m.offset(0, 1).value
pos = application.worksheetfunction.match(e_p, worksheets(1).range(erange), 0) '查找終點(diǎn)在起點(diǎn)列出現(xiàn)的行數(shù)
if pos = "" then
curcell.offset(0, -1).value = "no"
goto mynext '若沒(méi)有找到則設(shè)為"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 '若符合條件則在對(duì)應(yīng)記錄前標(biāo)記
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列單元格內(nèi)容等于另一行b列單元格內(nèi)容,就檢查第一行b列單元格內(nèi)容是否等于另一行a列單元格內(nèi)容,若相等就在這兩行前做標(biāo)記.否則標(biāo)記為no
