返回列表 上一主題 發帖

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

[發問] 開啟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
一分努力,一分收穫。
發問題前可以先搜索內文是否有相關範例。

回復 7# GBKEE


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

TOP

本帖最後由 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

回復 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

回復 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

回復 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

回復 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

請問版主有簡短的寫法嗎?
  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

        靜思自在 : 【是否發揮了良能?】人間壽命因為短暫,才更顯得珍貴。難得來一趟人間,應問是否為人間發揮了自己的良能,而不要一味求長壽。
返回列表 上一主題