標題:
[發問]
有關比對不同EXCEL表中資料的內容，藉以找出重複資料~
[打印本頁]
作者:
jiunyanwu
時間:
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
時間:
2013-4-26 13:30
回復
1#
jiunyanwu
比對組是不同檔案名稱 還是 不同工作表名稱?
不同比對組的資料都是同一欄嗎? 是哪一欄?
附上檔案做例子會比較好解決~
作者:
jiunyanwu
時間:
2013-4-26 16:00
本帖最後由 jiunyanwu 於 2013-4-26 16:02 編輯
原則上，「比對組」是指檔案名字，工作表名字都是Sheet1 。
另外，要比對的都是同一欄~
謝謝樓上大大提醒，小弟上傳了範例檔！
作者:
GBKEE
時間:
2013-4-26 16:55
回復
3#
jiunyanwu
如果有的話，就將比對組的符合資料顯示出來。
這也要有範例說明如何顯示出來
作者:
jiunyanwu
時間:
2013-4-26 17:05
回復
4#
GBKEE
謝謝大大指教
如果顯示方式是「另開一個工作表，並將有重複資料的那些列，複製到工作表內」是否很麻煩？
或者有其他較簡單方式可讓我們直接知道哪些比對組的哪些列有重複呢？
不好意思，敘述不夠清楚。
作者:
stillfish00
時間:
2013-4-29 17:06
回復
5#
jiunyanwu
新增模組至基準資料庫 , 複製貼上代碼 , 存成xlsm
Sub Test()
Dim f, i, r
Dim arName() As String
Dim wb As Workbook
f = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*),*.xls*", Title:="選擇比對檔案", MultiSelect:=True)
If Not IsArray(f) Then Exit Sub
With Sheets("基準資料庫")
For Each it In .Range("A1:A4,B1:B2") '要篩選的字
If it <> "" Then
If i = 0 Then
ReDim arName(i)
Else
ReDim Preserve arName(i)
End If
arName(i) = "=""=*" & it & "*"""
i = i + 1
End If
Next
End With
Set wb = Workbooks.Add
With wb
With .Sheets(1)
.Name = "Criteria"
.[A1:C1] = Array("代號", "電話", "資料") 'Write Header
.[C2].Resize(UBound(arName)).Value = Application.Transpose(arName) 'Write Criteria
End With
.Sheets(2).Name = "篩選結果"
End With
r = 1
For Each it In f
With Workbooks.Open(it).Sheets(1)
'進階篩選
.Range("A1:C6").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wb.Sheets(1).[A1].CurrentRegion, CopyToRange:=wb.Sheets(2).Range("A" & r), Unique:=False
.Parent.Close False
End With
With wb.Sheets(2)
If r > 1 Then .Rows(r).Delete xlShiftUp 'Delete Header
r = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End With
Next
End Sub
複製代碼
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)
