返回列表 上一主題 發帖

[發問] 開啟2個Excel做資料比對

faye59
　暱稱: 温奇
　頭銜: 議論者

中學生Rank: 2

帖子
104 
主題
5 
精華
0 
積分
110 
點名
0  
作業系統
win7 
軟體版本
Office2007 
閱讀權限
20 
性別
男 
註冊時間
2017-11-14 
最後登錄
2019-4-30 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2018-7-5 00:22 | 只看該作者

[發問] 開啟2個Excel做資料比對

請問有誰可以教我嗎...
剛剛看了一篇[發問] 請問VBA可以做到兩檔案比對後再產生另一檔案的比對結果嗎?
看了好久還是看不懂...
懇請高手指導
我要如何用Excel A去比對Excel B的資料再回傳Excel A指定的欄位?
假設王大陸進入時間18:00離開18:30，相減後運動總時數為30分鐘，
然後比對Excel B他應該每次運動應要滿2小時，
所以符合運動時間要回填不符合。
陳意涵進入時間18:00離開21:20，相減後2小時20分鐘，
符合運動時間要回填符合。

有指定的活頁名稱
Excel "A.xlsx" (Sheets("Form"))
姓名        健身房進入時間        健身房離開時間        符合運動時間
王大陸        2018-07-01 18:00:00        2018-07-01 18:30:00       
陳意涵        2018-07-02 18:00:00        2018-07-02 21:20:00       
蔡依林        2018-07-01 08:00:00        2018-07-01 09:00:00       
羅志祥        2018-07-03 16:00:00        2018-07-03 18:00:00       
光良        2018-07-04 18:00:00        2018-07-04 20:00:00       
張棟樑        2018-07-04 16:00:00        2018-07-04 20:00:00       

Excel "B.xlsx" (Sheets("Time"))
姓名        運動時間
王大陸        02:00:00
陳意涵        02:00:00
光良        03:00:00
蔡依林        01:00:00
羅志祥        01:00:00
張棟樑        02:00:00
收藏 分享
一分努力，一分收穫。
發問題前可以先搜索內文是否有相關範例。

faye59
　暱稱: 温奇
　頭銜: 議論者

中學生Rank: 2

帖子
104 
主題
5 
精華
0 
積分
110 
點名
0  
作業系統
win7 
軟體版本
Office2007 
閱讀權限
20 
性別
男 
註冊時間
2017-11-14 
最後登錄
2019-4-30 

論壇榮譽勳章論壇贊助勳章
2#
發表於 2018-7-7 22:38 | 只看該作者
請問版主有簡短的寫法嗎?
  1. Sub ex()
  2. Dim f1, f2, f5 As Workbook
  3. Set f1 = Sheets("Form")
  4. Set f2 = Sheets("Time")
  5. For Each aa In Range([A2], [A2].End(xlDown))
  6. a = Application.WorksheetFunction.Text(aa.Offset(0, 2) - aa.Offset(0, 1), "dd hh:mm:ss")
  7. Set Wb = Workbooks.Open("\\Test\B.xlsx")
  8.     For m = 2 To Application.CountA(Wb.Sheets("Time").Range("A:A"))
  9.         If Workbooks("A.xlsm").f1.Offset(, 1) = Wb.Sheets("Time").Cells(m, 1) Then
  10.             If a >= Application.WorksheetFunction.Text(Wb.Sheets("Time").Cells(m, 2), "dd hh:mm:ss") Then
  11.             Workbooks("A.xlsm").f1.Offset(, 3) = "足夠"
  12.             Exit For
  13.             Else
  14.             Workbooks("A.xlsm").f1.Offset(, 3) = "不足"
  15.             Exit For
  16.             End If
  17.         End If
  18.     Next
  19. Wb.Sheets("AgingUpData").Parent.Close False
  20. End Sub
複製代碼
一分努力，一分收穫。
發問題前可以先搜索內文是否有相關範例。

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 2018-8-1 14:23 | 只看該作者
回復 2# faye59
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range, D As Object, E As Range
  4.     With Sheets("Form")
  5.         Set Rng = .Range(.[d2], .Range("d" & .[a2].End(xlDown).Row))  '符合運動時間的列位
  6.     End With
  7.     Rng = "=IF(rc[-1]-rc[-2]>=TIMEVALUE(""02:00:00""),""符合"",""不符合"")"  '寫上公式 (健身房離開時間-健身房進入時間>=02:00:00)
  8.     Rng.Value = Rng.Value  '公式轉為值
  9.     Set D = CreateObject("Scripting.Dictionary")   '字典物件
  10.     For Each E In Rng       'Rng.Cells 的迴圈
  11.         D(E.Offset(, -3).Text) = E.Text  '關鍵字-> E.Offset(, -3)為姓名帶入 (符合/不符合)
  12.     Next
  13.     '重設Rng變數
  14.     Set Rng = Workbooks.Open("\\Test\B.xlsx").Sheets("Time").Range("A:A").SpecialCells(xlCellTypeConstants)
  15.    
  16.     For Each E In Rng
  17.         If D.EXISTS(E.Text) Then E.Offset(, 1) = D(E.Text)  'E為A欄 -> E.Offset(, 1)= B欄
  18.         '字典物件的Exists 方法 :字典物件的關鍵字存在時為TTrue, 執行(Then  .... )
  19.     Next
  20.     Rng.Parent.Parent.Close False
  21.     'Rng.Parent 是Sheets("Time")
  22.     'Rng.Parent.Parent為Workbook
  23. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

faye59
　暱稱: 温奇
　頭銜: 議論者

中學生Rank: 2

帖子
104 
主題
5 
精華
0 
積分
110 
點名
0  
作業系統
win7 
軟體版本
Office2007 
閱讀權限
20 
性別
男 
註冊時間
2017-11-14 
最後登錄
2019-4-30 

論壇榮譽勳章論壇贊助勳章
4#
發表於 2018-8-1 20:55 | 只看該作者
回復 3# GBKEE


    Option Explicit
Sub Ex()
    Dim Rng As Range, D As Object, E As Range
    With Sheets("Form")
        Set Rng = .Range(.[d2], .Range("d" & .[a2].End(xlDown).Row))  '符合運動時間的列位
    End With
    Rng = "=IF(rc[-1]-rc[-2]>=TIMEVALUE(""02:00:00""),""符合"",""不符合"")"  '寫上公式 (健身房離開時間-健身房進入時間>=02:00:00)
    Rng.Value = Rng.Value  '公式轉為值
    Set D = CreateObject("Scripting.Dictionary")   '字典物件
    For Each E In Rng       'Rng.Cells 的迴圈
        D(E.Offset(, -3).Text) = E.Text  '關鍵字-> E.Offset(, -3)為姓名帶入 (符合/不符合)
    Next
    '重設Rng變數
    Set Rng = Workbooks.Open("\\Test\B.xlsx").Sheets("Time").Range("A:A").SpecialCells(xlCellTypeConstants)
   
    For Each E In Rng
        If D.EXISTS(E.Text) Then E.Offset(, 1) = D(E.Text)  'E為A欄 -> E.Offset(, 1)= B欄
        '字典物件的Exists 方法 :字典物件的關鍵字存在時為TTrue, 執行(Then  .... )
    Next
    Rng.Parent.Parent.Close False
    'Rng.Parent 是Sheets("Time")
    'Rng.Parent.Parent為Workbook
End Sub


GBKEE超板
不好意思，我有修正一些判斷式，
需要比對B檔案中的運動時間資料是否符合，
當沒有這個人員時回傳"沒會員"，
並在A檔案中E欄未填入該員本次運動時間。
  1. Option Explicit
  2. Sub ex()
  3.     Dim S  As Variant, Wb As Workbook, Wb_Name As String
  4.     Dim n, m As Long
  5.     Application.ScreenUpdating = False
  6.     Set Wb = Workbooks.Open("\\TW100019913\Access\B.xlsx")
  7.         For n = 2 To Application.CountA(Workbooks("A.xlsm").Sheets("Form").Range("A:A"))
  8.         S = Application.WorksheetFunction.Text(Workbooks("A.xlsm").Sheets("Form").Cells(n, 3) - Workbooks("A.xlsm").Sheets("Form").Cells(n, 2), "dd hh:mm:ss")
  9.         Workbooks("A.xlsm").Sheets("Form").Cells(n, 5) = S
  10.             For m = 2 To Application.CountA(Wb.Sheets("Time").Range("A:A"))
  11.             If Workbooks("A.xlsm").Sheets("Form").Cells(n, 1) = Wb.Sheets("Time").Cells(m, 1) Then '判斷B.xlsx有沒有人員資料
  12.                 If S >= Application.WorksheetFunction.Text(Wb.Sheets("Time").Cells(m, 2), "dd hh:mm:ss") Then '比對人員本次運動時間是否達到標準
  13.                     Workbooks("A.xlsm").Sheets("Form").Cells(n, 4) = "足夠"
  14.                     Exit For
  15.                 Else
  16.                     Workbooks("A.xlsm").Sheets("Form").Cells(n, 4) = "不足"
  17.                     Exit For
  18.                 End If
  19.             Else
  20.                 Workbooks("A.xlsm").Sheets("Form").Cells(n, 4) = "沒會員"
  21.             End If
  22.             Next
  23.         Next
  24.     Wb.Sheets("Time").Parent.Close False
  25. End Sub
複製代碼
附上檔案

Access.rar (25.1 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兔年全勤獎章
5#
發表於 2018-8-6 15:55 | 只看該作者
回復 4# faye59
  1. Option Explicit
  2. Sub Ex()
  3.     Dim  D As Object, i As Integer , xTime As Date
  4.     Set D = CreateObject("Scripting.Dictionary")   '字典物件
  5.     With Workbooks.Open("\\Tank\Access\B.xlsx").Sheets("Time").Range("A:A")
  6.         i = 2
  7.         Do While .Cells(i) <> ""
  8.         If Not IsDate(.Cells(i, "B")) Then MsgBox .Cells(i) & " - " & .Cells(i, "B") & " 不是正確時間 ": End
  9.             D(.Cells(i).Text) = Application.Text(.Cells(i, "B"), "HH:MM")
  10.             i = i + 1
  11.         Loop
  12.     End With
  13.     With Sheets("Form").Range("A:A")
  14.         i = 2
  15.         Do While .Cells(i) <> ""
  16.             If D.EXISTS(.Cells(i).Text) Then
  17.                 .Cells(i, "E") = D(.Cells(i).Text)
  18.                 xTime = Application.Text(.Cells(i, "C") - .Cells(i, "B"), "HH:MM")
  19.                 If xTime >= D(.Cells(i).Text) Then
  20.                     .Cells(i, "D") = "足夠"
  21.                 Else
  22.                     .Cells(i, "D") = "不足夠"
  23.                 End If
  24.             Else
  25.                 .Cells(i, "d") = "沒會員"
  26.             End If
  27.             i = i + 1
  28.         Loop
  29.     End With
  30. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

faye59
　暱稱: 温奇
　頭銜: 議論者

中學生Rank: 2

帖子
104 
主題
5 
精華
0 
積分
110 
點名
0  
作業系統
win7 
軟體版本
Office2007 
閱讀權限
20 
性別
男 
註冊時間
2017-11-14 
最後登錄
2019-4-30 

論壇榮譽勳章論壇贊助勳章
6#
發表於 2018-8-9 07:09 | 只看該作者
回復 5# GBKEE
  1.     If Not IsDate(.Cells(i, "B")) Then MsgBox .Cells(i) & " - " & .Cells(i, "B") & " 不是正確時間 ": End
複製代碼
我一直跳出這段Msgbox訊息
超板的意思是先將B.xlsx內所有資料建成字典嗎?
再將字典套入A.xlsm填寫資訊?
可是為什麼要If Not IsDate
不是很明白這段意思...
一分努力，一分收穫。
發問題前可以先搜索內文是否有相關範例。

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2018-8-9 08:04 | 只看該作者
本帖最後由 GBKEE 於 2018-8-9 08:11 編輯

回復 6# faye59
If Not IsDate(.Cells(i, "B"))      **檢查  .Cells(i, "B")是否為 有效日期**
'**如果運算式是一個日期，或是像有效日期一樣可識別的，IsDate 會傳回True；否則它會傳回 False**

是在檢查B.xlsx的運動時間是否輸入正確的時間數值
B.xlsx的工作表TIME, C2=ISNUMBER(B2) 傳回False  **不是數值
B.xlsx的工作表TIME, C2=ISTEXT(B2)        傳回True  **是文字

B.xlsx的工作表TIME, C3=ISNUMBER(B3)  傳回True  **是數值
B.xlsx的工作表TIME, C3=ISTEXT(B3)          傳回False  **不是文字
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

faye59
　暱稱: 温奇
　頭銜: 議論者

中學生Rank: 2

帖子
104 
主題
5 
精華
0 
積分
110 
點名
0  
作業系統
win7 
軟體版本
Office2007 
閱讀權限
20 
性別
男 
註冊時間
2017-11-14 
最後登錄
2019-4-30 

論壇榮譽勳章論壇贊助勳章
8#
發表於 2018-8-9 20:56 | 只看該作者
回復 7# GBKEE


    明白了...原來是我B.xlsx檔案儲存格內輸入文字，
還想說我都已經設定成日期為何還要Not IsDate...
B檔案我是用VB.net設定填上資料，當初第一筆是手動在填寫才填錯了吧!
這細節還真沒注意到，問題已解決。
謝謝GBKEE超板回覆!
一分努力，一分收穫。
發問題前可以先搜索內文是否有相關範例。

TOP

        靜思自在 : 【時間成就一切】時間可以造就人格，可以成就事業，也可以儲積功德。
返回列表 上一主題