[發問] 開啟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 | 顯示全部帖子

請問版主有簡短的寫法嗎?

Sub ex()
Dim f1, f2, f5 As Workbook
Set f1 = Sheets("Form")
Set f2 = Sheets("Time")
For Each aa In Range([A2], [A2].End(xlDown))
a = Application.WorksheetFunction.Text(aa.Offset(0, 2) - aa.Offset(0, 1), "dd hh:mm:ss")
Set Wb = Workbooks.Open("\\Test\B.xlsx")
For m = 2 To Application.CountA(Wb.Sheets("Time").Range("A:A"))
If Workbooks("A.xlsm").f1.Offset(, 1) = Wb.Sheets("Time").Cells(m, 1) Then
If a >= Application.WorksheetFunction.Text(Wb.Sheets("Time").Cells(m, 2), "dd hh:mm:ss") Then
Workbooks("A.xlsm").f1.Offset(, 3) = "足夠"
Exit For
Else
Workbooks("A.xlsm").f1.Offset(, 3) = "不足"
Exit For
End If
End If
Next
Wb.Sheets("AgingUpData").Parent.Close False
End Sub

複製代碼

一分努力，一分收穫。
發問題前可以先搜索內文是否有相關範例。

TOP

faye59

　暱稱: 温奇
　頭銜: 議論者

中學生 Rank: 2

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

論壇榮譽勳章論壇贊助勳章

3^#

發表於 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欄未填入該員本次運動時間。

Option Explicit
Sub ex()
Dim S As Variant, Wb As Workbook, Wb_Name As String
Dim n, m As Long
Application.ScreenUpdating = False
Set Wb = Workbooks.Open("\\TW100019913\Access\B.xlsx")
For n = 2 To Application.CountA(Workbooks("A.xlsm").Sheets("Form").Range("A:A"))
S = Application.WorksheetFunction.Text(Workbooks("A.xlsm").Sheets("Form").Cells(n, 3) - Workbooks("A.xlsm").Sheets("Form").Cells(n, 2), "dd hh:mm:ss")
Workbooks("A.xlsm").Sheets("Form").Cells(n, 5) = S
For m = 2 To Application.CountA(Wb.Sheets("Time").Range("A:A"))
If Workbooks("A.xlsm").Sheets("Form").Cells(n, 1) = Wb.Sheets("Time").Cells(m, 1) Then '判斷B.xlsx有沒有人員資料
If S >= Application.WorksheetFunction.Text(Wb.Sheets("Time").Cells(m, 2), "dd hh:mm:ss") Then '比對人員本次運動時間是否達到標準
Workbooks("A.xlsm").Sheets("Form").Cells(n, 4) = "足夠"
Exit For
Else
Workbooks("A.xlsm").Sheets("Form").Cells(n, 4) = "不足"
Exit For
End If
Else
Workbooks("A.xlsm").Sheets("Form").Cells(n, 4) = "沒會員"
End If
Next
Next
Wb.Sheets("Time").Parent.Close False
End Sub