返回列表 上一主題 發帖

[發問] 有關比對不同EXCEL表中資料的內容，藉以找出重複資料~

jiunyanwu

帖子
3 
主題
1 
精華
0 
積分
4 
點名
0  
作業系統
windows 7 
軟體版本
Office 2007 
閱讀權限
10 
性別
男 
註冊時間
2013-4-26 
最後登錄
2013-4-26 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-4-26 10:36 | 只看該作者

[發問] 有關比對不同EXCEL表中資料的內容，藉以找出重複資料~

本帖最後由 jiunyanwu 於 2013-4-26 10:38 編輯

今天我有多個excel檔案
其中一個excel檔案，有一工作表名為「基準資料庫」
裡頭的內容為：
               阿貓
               阿狗
               阿猴
               阿豬
      .....
     .....
另一個檔案，有一個工作表，名為「比對組1」
裡頭內容為：
         代號          電話        資料
   1     a               123        我是阿貓
   2     b               456       我是阿熊
   3     c                789       誰不是大豬
.....
...
其他excel檔案亦分別有工作表，名為「比對組2」、「比對組3」......等多個檔案

今天我要以「基準資料庫」為基準，來比對「比對組1」、比對組2、……，看裡頭內容是否有基準資料庫的資料
如果有的話，就將比對組的符合資料顯示出來。
(如上述範例，就有第一列的資料符合)

這樣要如何用vba來呈現呢？
小弟已經困擾好久了，不知是否有高手能為小弟解惑，謝謝！！
收藏 分享

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 2013-4-26 13:30 | 只看該作者
回復 1# jiunyanwu
比對組是不同檔案名稱 還是 不同工作表名稱?
不同比對組的資料都是同一欄嗎? 是哪一欄?
附上檔案做例子會比較好解決~

TOP

jiunyanwu

帖子
3 
主題
1 
精華
0 
積分
4 
點名
0  
作業系統
windows 7 
軟體版本
Office 2007 
閱讀權限
10 
性別
男 
註冊時間
2013-4-26 
最後登錄
2013-4-26 
3#
發表於 2013-4-26 16:00 | 只看該作者
本帖最後由 jiunyanwu 於 2013-4-26 16:02 編輯

原則上，「比對組」是指檔案名字，工作表名字都是Sheet1 。
另外，要比對的都是同一欄~
謝謝樓上大大提醒，小弟上傳了範例檔！

範例.rar (20.06 KB)

範例

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2013-4-26 16:55 | 只看該作者
回復 3# jiunyanwu
如果有的話，就將比對組的符合資料顯示出來。
這也要有範例說明如何顯示出來
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jiunyanwu

帖子
3 
主題
1 
精華
0 
積分
4 
點名
0  
作業系統
windows 7 
軟體版本
Office 2007 
閱讀權限
10 
性別
男 
註冊時間
2013-4-26 
最後登錄
2013-4-26 
5#
發表於 2013-4-26 17:05 | 只看該作者
回復 4# GBKEE


   謝謝大大指教
如果顯示方式是「另開一個工作表，並將有重複資料的那些列，複製到工作表內」是否很麻煩？
或者有其他較簡單方式可讓我們直接知道哪些比對組的哪些列有重複呢？
不好意思，敘述不夠清楚。

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
6#
發表於 2013-4-29 17:06 | 只看該作者
回復 5# jiunyanwu
新增模組至基準資料庫 , 複製貼上代碼 , 存成xlsm
  1. Sub Test()
  2.     Dim f, i, r
  3.     Dim arName() As String
  4.     Dim wb As Workbook
  5.    
  6.     f = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*),*.xls*", Title:="選擇比對檔案", MultiSelect:=True)
  7.     If Not IsArray(f) Then Exit Sub
  8.    
  9.     With Sheets("基準資料庫")
  10.         For Each it In .Range("A1:A4,B1:B2")    '要篩選的字
  11.             If it <> "" Then
  12.                 If i = 0 Then
  13.                     ReDim arName(i)
  14.                 Else
  15.                     ReDim Preserve arName(i)
  16.                 End If
  17.                 arName(i) = "=""=*" & it & "*"""
  18.                 i = i + 1
  19.             End If
  20.         Next
  21.     End With
  22.    
  23.     Set wb = Workbooks.Add
  24.     With wb
  25.         With .Sheets(1)
  26.             .Name = "Criteria"
  27.             .[A1:C1] = Array("代號", "電話", "資料")    'Write Header
  28.             .[C2].Resize(UBound(arName)).Value = Application.Transpose(arName)  'Write Criteria
  29.         End With
  30.         .Sheets(2).Name = "篩選結果"
  31.     End With
  32.    
  33.    
  34.     r = 1
  35.     For Each it In f
  36.         With Workbooks.Open(it).Sheets(1)
  37.             '進階篩選
  38.             .Range("A1:C6").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wb.Sheets(1).[A1].CurrentRegion, CopyToRange:=wb.Sheets(2).Range("A" & r), Unique:=False
  39.             .Parent.Close False
  40.         End With
  41.         With wb.Sheets(2)
  42.             If r > 1 Then .Rows(r).Delete xlShiftUp   'Delete Header
  43.             r = .Range("A" & .Rows.Count).End(xlUp).Row + 1
  44.         End With
  45.     Next
  46. End Sub
複製代碼

TOP

        靜思自在 : 【停滯不前，終無所得】人都迷於尋找奇蹟，因而停滯不前；縱使時間再多、路再長，也了無用處，終無所得。
返回列表 上一主題