客服人員發現地市分公司上報的理賠郵件有重複現象，但人工檢查重複非常麻煩，因為這些號碼不在乙個工作表中。為此我做了乙個小工具，可以一鍵列出excel檔案中所有工作表中重複的號碼。有了這個工具，不僅可以篩選重複郵件號碼，也可以用於篩選其他重複的東西，比如姓名、身份證號碼等等。
1、工具介面
為了提高工具的適應能力，有些引數可以讓使用者自己設定的，比如檔名、篩選重複的列、資料起始行、附加資訊等，介面如下，其中的工作表名稱是用日期命名的：
2、功能實現
功能比較簡單，無非是迴圈比較。讀取需要比較的號碼列及附加列資訊，然後就是比較了。取乙個號碼，首先比較本表有沒有重複，然後再讀取其他表號碼列比較，發現有重複的，記錄下號碼和附加資訊，重複資訊。考慮4個重複已經夠了，所以表中最多可以記錄4個重複資訊，如果超過4個，則標註乙個「*」號，不再記錄。
還有乙個問題要注意，數字類的號碼可以是數字格式，也可以是文字格式，如果格式不同，即便號碼相同也是不等的，如果不注意，可能會漏掉重複號碼。安全的解決辦法是比較時，轉換為文字格式。
如果有需要，還可以在此基礎上增加其他功能，比如刪除重複號碼，給重複號碼單元格加上標誌等等。如果是刪除號碼，有乙個技巧，就是從後面向前面刪除，這樣刪除的號碼不會影響前面號碼的定位。
**如下：
'篩重
sub get_rep()
dim maxrow, maxrow1, maxrow2 as long
dim i, j, k1, k2, datano1, datano2, repno, rr, cc, stnum as integer
dim mail, colmail, colfee, rowfirst, datfile as string
dim arradd1(), arradd2(), arrdata1(), arrdata2(), repdata(1000, 14)
colpm = 17
datfile = cells(3, colpm) '檔名稱
colmail = cells(4, colpm) '郵件號碼列
rowfirst = cells(5, colpm) '起始行
coladd1 = cells(6, colpm) '附加列1
coladd2 = cells(7, colpm) '附加列2
maxrow = activesheet.usedrange.rows.count
if maxrow >= 3 then
activesheet.range("a3:n" & maxrow).clearcontents
end if
'開啟檔案
maxrow = openfile(datfile)
stnum = sheets.count
rr = 1
cc = 1
for k1 = 1 to stnum
maxrow1 = sheets(k1).[a65536].end(xlup).row
if maxrow1 >= rowfirst then
datano1 = maxrow1 - rowfirst + 1
arrdata1 = sheets(k1).range(colmail & rowfirst & ":" & colmail & maxrow1).value
arradd1 = sheets(k1).range(coladd1 & rowfirst & ":" & coladd1 & maxrow1).value
arradd2 = sheets(k1).range(coladd2 & rowfirst & ":" & coladd2 & maxrow1).value
for i = 1 to datano1
mail = cstr(arrdata1(i, 1))
'查詢本表重複
for j = i + 1 to datano1
if mail = cstr(arrdata1(j, 1)) then
if cc = 1 then
repdata(rr, 1) = arrdata1(i, 1)
repdata(rr, 2) = arradd1(i, 1)
repdata(rr, 3) = arradd2(i, 1)
repdata(rr, 4) = sheets(k1).name
repdata(rr, 5) = rowfirst + i - 1
repdata(rr, 6) = sheets(k1).name '重複項存放開始列：6、8、10、12列
repdata(rr, 7) = rowfirst + j - 1
cc = 8
else
repdata(rr, cc) = sheets(k1).name
repdata(rr, cc + 1) = rowfirst + j - 1
cc = cc + 2
end if
end if
next j
'查詢剩餘工作表重複
for k2 = k1 + 1 to stnum
maxrow2 = sheets(k2).[a65536].end(xlup).row
if maxrow2 >= rowfirst then
datano2 = maxrow2 - rowfirst + 1
arrdata2 = sheets(k2).range(colmail & rowfirst & ":" & colmail & maxrow2).value
for j = 1 to datano2
if mail = cstr(arrdata2(j, 1)) then
if cc = 1 then
repdata(rr, 1) = arrdata1(i, 1)
repdata(rr, 2) = arradd1(i, 1)
repdata(rr, 3) = arradd2(i, 1)
repdata(rr, 4) = sheets(k1).name
repdata(rr, 5) = rowfirst + i - 1
repdata(rr, 6) = sheets(k2).name '重複項存放開始列：6、8、10、12列
repdata(rr, 7) = rowfirst + j - 1
cc = 8
else
if cc = 14 then '超過4個以上重複，後面標註*號，不在判斷
repdata(rr, cc) = "*"
cc = cc + 2
exit for
else
repdata(rr, cc) = sheets(k2).name
repdata(rr, cc + 1) = rowfirst + j - 1
cc = cc + 2
end if
end if
end if
next j
if cc > 14 then exit for '超過4個以上重複，後面不在判斷
end if
next k2
'本號查詢完畢，如果有重複，重新初始化
if cc > 1 then
rr = rr + 1
cc = 1
end if
next i
end if
next k1
activewindow.close
'儲存篩重結果
repno = rr - 1
if repno > 0 then
for rr = 1 to repno
for cc = 1 to 14
cells(rr + 2, cc) = repdata(rr, cc)
next cc
next rr
end if
msg = msgbox("篩重完畢，共發現" & repno & "個郵件號碼重複！", vbokonly, "ａｈｅｍｓ：iamlaosong")
end sub
利用VBA篩選重複資料
目標 在重複資料中按照一定規則提取 組合。sub match dim i,j,z,n,flag,a,b,c set a worksheets sheet1 usedrange set b worksheets sheet2 usedrange set c worksheets sheet3 used...
EXCEL 一組資料篩選出重複的資料 去重
一 excel 2007使用 在excel中錄入資料後，我們一般用高階篩選來處理刪除重複的記錄，excel 2007保留了這個功能，同時又增加了乙個 刪除重複項 按鈕，使操作更加簡單 靈活。一 傳統方法 使用高階篩選 步驟如下 1.單擊資料區，選中其中的任乙個單元格。如果只是針對其中部分欄位和記錄進...
EXCEL 一組資料篩選出重複的資料 去重
一 excel 2007使用 在excel中錄入資料後，我們一般用高階篩選來處理刪除重複的記錄，excel 2007保留了這個功能，同時又增加了乙個 刪除重複項 按鈕，使操作更加簡單 靈活。一 傳統方法 使用高階篩選 步驟如下 1.單擊資料區，選中其中的任乙個單元格。如果只是針對其中部分欄位和記錄進...