123456
返回列表 上一主題 發帖

[發問] 請問VBA可以做到兩檔案比對後再產生另一檔案的比對結果嗎?

happycoccolin
　暱稱: NANAKO

中學生Rank: 2

帖子
72 
主題
7 
精華
0 
積分
88 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
女 
註冊時間
2012-6-28 
最後登錄
2018-11-14 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-7-25 11:09 | 只看該作者

[發問] 請問VBA可以做到兩檔案比對後再產生另一檔案的比對結果嗎?

請問一下大師們~

目前手邊有一近五萬筆的資料庫--A資料 我們需要將手邊的B資料與之做比對

請問VBA有沒有辦法做出一個檔案 開啟後直接載入EXCEL的A檔案 與B檔案 比對後產生C檔案呢?
C檔案以B檔案格式為主 向後多加欄位"K"
K欄位內容是A檔案的A欄位

比對內容是

A檔案的E欄位 與 B檔案的J欄位比較(可忽略"-")

A檔案的格式如下
A                 B           C                       D                         E
100-1       XXX      XXX                 XXX                   DOG
100-2       XXX      XXX                 XXX                   CAT
100-3       XXX      XXX                 XXX                   CAT-1
100-4       XXX      XXX                 XXX                   CAT-2

B檔案的格式如下
A                 B           C                       D                         E                      F                       G             H                I           J
11            XX          XX                      XX                       XX                 XX                        XX         XX            CC       DOG
12            XX          XX                      XX                       XX                 XX                        XX         XX            CC       CAT
13            XX          XX                      XX                       XX                 XX                        XX         XX            CC       CAT1
14            XX          XX                      XX                       XX                 XX                        XX         XX            CC       CAT-1
15            XX          XX                      XX                       XX                 XX                        XX         XX            CC       CAT3

比對結果希望產生C檔案
A                 B           C                       D                         E                      F                       G             H                I           J                K
11            XX          XX                      XX                       XX                 XX                        XX         XX            CC       DOG       100-1
12            XX          XX                      XX                       XX                 XX                        XX         XX            CC       CAT          100-2
13            XX          XX                      XX                       XX                 XX                        XX         XX            CC       CAT1        100-3
14            XX          XX                      XX                       XX                 XX                        XX         XX            CC       CAT-1       100-3
15            XX          XX                      XX                       XX                 XX                        XX         XX            CC       CAT3          No Data
收藏 分享

happycoccolin
　暱稱: NANAKO

中學生Rank: 2

帖子
72 
主題
7 
精華
0 
積分
88 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
女 
註冊時間
2012-6-28 
最後登錄
2018-11-14 
2#
發表於 2013-7-25 11:15 | 只看該作者
忘了附檔.....稍後附上檔案~

TOP

happycoccolin
　暱稱: NANAKO

中學生Rank: 2

帖子
72 
主題
7 
精華
0 
積分
88 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
女 
註冊時間
2012-6-28 
最後登錄
2018-11-14 
3#
發表於 2013-7-25 11:21 | 只看該作者
回復 2# happycoccolin


    :$ 若有空請大家看看是否可以達成~~~謝謝!!!!!

ABC.zip (19.03 KB)

TOP

vocolboy

帖子
2 
主題
1 
精華
0 
積分
21 
點名
0  
作業系統
xp 
軟體版本
office2003 
閱讀權限
10 
性別
男 
註冊時間
2013-7-18 
最後登錄
2018-5-22 
4#
發表於 2013-7-25 14:47 | 只看該作者
本帖最後由 vocolboy 於 2013-7-25 14:48 編輯

回復 1# happycoccolin

我也是剛學的不能下載付件直接從你上述的寫

Sub 比對()
Set d = CreateObject("Scripting.Dictionary")          '字典
With Workbooks("A.xls").Sheets(1)                       'with 報名名稱.工作表名稱
  For Each a In .Range(.[E2], .[E65536].End(xlUp))
   d(a & "") = Array(a.Offset(, -4).Value)
  Next
End With
With Workbooks("B.xls").Sheets(1)                                       
  For Each a In .Range(.[J2], .[J65536].End(xlUp))
    a.Offset(, 1).Resize(, 1).Value = d(a & "")
  Next
End With
End Sub


這個結果並不會產生到C新的上
他會match在B裡面
我想這只是個複製貼上小問題@@

TOP

happycoccolin
　暱稱: NANAKO

中學生Rank: 2

帖子
72 
主題
7 
精華
0 
積分
88 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
女 
註冊時間
2012-6-28 
最後登錄
2018-11-14 
5#
發表於 2013-7-25 16:14 | 只看該作者
回復 4# vocolboy


    哈囉~~謝謝vocolboy ~

請問一下 是否可以有一個檔案 開啟以後 讓我按鈕選擇載入兩個檔案比對呢?

例如

按鈕一  請選擇檔案
按鈕二  請選擇檔案
按鈕三  開始比對

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2013-7-25 16:56 | 只看該作者
回復 4# vocolboy
  1. Option Explicit
  2. Sub Ex()
  3.     Dim d As Object, i As Variant, S  As Variant
  4.     Set d = CreateObject("scripting.dictionary")
  5.     i = 1
  6.     With Workbooks("A.xls").Sheets(1)
  7.         Do While .Cells(i, "e") <> ""
  8.             d(.Cells(i, "e").Value) = .Cells(i, "A").Value
  9.             i = i + 1
  10.         Loop
  11.     End With
  12.      i = 1
  13.     With Workbooks("B.xls").Sheets(1)
  14.         Do While .Cells(i, "J") <> ""
  15.            S = Join(Application.Transpose(Application.Transpose(.Range("A" & i & ":J" & i))), ",")
  16.            If d.Exists(.Cells(i, "J").Value) Then
  17.                 S = S & "," & d(.Cells(i, "J").Value)
  18.                 d(.Cells(i, "J").Value) = Split(S, ",")
  19.            Else
  20.                 d(.Cells(i, "J").Value) = Split(S & ",No Data", ",")
  21.                 S = d(.Cells(i, "J").Value)
  22.            
  23.            End If
  24.             i = i + 1
  25.         Loop
  26.     End With
  27.     For Each i In d.keys
  28.         If InStr(i, "-") Then If Mid(i, InStr(i, "-"), 2) <> "-1" Then d.Remove i        '可忽略"-"的步驟
  29.     Next
  30.     With Workbooks("C.xls").Sheets(1)
  31.         .Cells.Clear
  32.         S = Application.Transpose(Application.Transpose(d.ITEMS))
  33.         .[A1].Resize(UBound(S, 1), UBound(S, 2)) = S
  34.     End With
  35. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

happycoccolin
　暱稱: NANAKO

中學生Rank: 2

帖子
72 
主題
7 
精華
0 
積分
88 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
女 
註冊時間
2012-6-28 
最後登錄
2018-11-14 
7#
發表於 2013-7-25 18:20 | 只看該作者
回復 6# GBKEE


    謝謝版大~~~

抱歉小妹才疏學淺...... 請問一下要怎麼使用才能做比對呢?

我將語法複製到模組中 但是如何才能正確使用?

目前偵錯停在
With Workbooks("A.xls").Sheets(1)

對VBA很有興趣但是未開竅 目前腳步很慢尚停留在函數階段 也請各位大師們多多見諒我問的笨問題..

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2013-7-25 19:24 | 只看該作者
回復 7# happycoccolin
xls 是2003版活頁簿的副檔名
2007版以後的副檔名xlsx是沒有巨集的活頁簿 ,副檔名xlsm是有巨集的活頁簿.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

happycoccolin
　暱稱: NANAKO

中學生Rank: 2

帖子
72 
主題
7 
精華
0 
積分
88 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
女 
註冊時間
2012-6-28 
最後登錄
2018-11-14 
9#
發表於 2013-7-26 11:34 | 只看該作者
回復 8# GBKEE


謝謝板大~

可以再請問一下嗎~如何不指定檔名~要做到人人都可以利用此檔案來做比對

那可以怎麼處理呢?

我現在是以A.xlsx為主,sheet1我加一個按鈕直接RUN此比對

如何載入欲比對的檔案呢?

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2013-7-26 13:47 | 只看該作者
回復 9# happycoccolin
  1. Option Explicit
  2. Sub Ex()
  3.     Dim d As Object, i As Variant, S  As Variant, Wb As Workbook
  4.     Set d = CreateObject("scripting.dictionary")
  5.     With Application.FileDialog(msoFileDialogFilePicker) 'FileDialog :表檔案對話方, msoFileDialogFilePicker(參數):選取檔案
  6.         .AllowMultiSelect = False                        '允許使用者從檔案對話方塊選取多個檔案=False
  7.          If .Show = False Then MsgBox "沒有選擇檔案 !!!":   Exit Sub
  8.          Set Wb = Workbooks.Open(.SelectedItems(1))   '開啟指定檔案
  9.     End With
  10.     i = 1
  11.     With Workbooks("A.xlsx").Sheets(1)   '
  12.         Do While .Cells(i, "e") <> ""
  13.             d(.Cells(i, "e").Value) = .Cells(i, "A").Value
  14.             i = i + 1
  15.         Loop
  16.     End With
  17.      i = 1
  18.     With Wb.Sheets(1)
  19.         Do While .Cells(i, "J") <> ""
  20.            S = Join(Application.Transpose(Application.Transpose(.Range("A" & i & ":J" & i))), ",")
  21.            If d.Exists(.Cells(i, "J").Value) Then
  22.                 S = S & "," & d(.Cells(i, "J").Value)
  23.                 d(.Cells(i, "J").Value) = Split(S, ",")
  24.            Else
  25.                 d(.Cells(i, "J").Value) = Split(S & ",No Data", ",")
  26.                 S = d(.Cells(i, "J").Value)
  27.            
  28.            End If
  29.             i = i + 1
  30.         Loop
  31.         .Parent.Close False               '關閉指定檔案不存檔
  32.     End With
  33.    
  34.     For Each i In d.keys
  35.         If InStr(i, "-") Then If Mid(i, InStr(i, "-"), 2) <> "-1" Then d.Remove i        '可忽略"-"的步驟
  36.     Next
  37.     With Workbooks("C.xlsx").Sheets(1)
  38.         .Cells.Clear
  39.         S = Application.Transpose(Application.Transpose(d.ITEMS))
  40.         .[A1].Resize(UBound(S, 1), UBound(S, 2)) = S
  41.     End With
  42. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 不怕事多，只怕多事。
123456
返回列表 上一主題