比較來自與操作工作簿分開的兩個工作簿的數據

Question

我基本上只使用三個工作簿。第一個是本書，它運行宏並最終設置數據。第二個是Reporting，它包含從TXT文件導入的一組數據，該文件定期附加來自我正在運行的另一個進程的數據。第三種是WeeklyData，它是從Access數據庫以excel的形式作爲一張表單提取出來的，代表我每週獲得一次的數據。

該程序在本書的A列中生成報表，該報表應顯示WeeklyData中未包含在報表中的任何條目。基本上，如果我運行的過程沒有使用我每週獲得的數據。我遇到了一些困難，因爲每次我嘗試運行它時，都會收到「應用程序定義或對象定義的錯誤」。不幸的是，它並沒有告訴我錯誤是什麼，但報告書是在這種情況發生時處於活動狀態的那本書。

Sub Find_Matches() 

Dim CompareRange As Variant, x As Variant, y As Variant 
Dim ReportingRange As Variant 

Dim thisBook As Workbook 
Set thisBook = ThisWorkbook 

Dim Match As Boolean 

Dim Weekly_Data As Workbook 
Set Weekly_Data = Workbooks.Open("Weekly Data.xlsx") 

Dim LastRow As Long 

Dim Reporting As Workbook 
Set Reporting = Workbooks.Open("Reporting.xlsm") 

On Error GoTo Errorcatch 

Set CompareRange = Weekly_Data.Worksheets("Sheet1")._ 
    Range("b2", Worksheets("Sheet1").Range("b2").End(xlDown)).Value 
Set ReportingRange = Reporting.Worksheets("Sheet1")._ 
    Range("a1", Worksheets("Sheet1").Range("a1").End(xlDown)).Value 

For Each x In CompareRange 
    Match = False 
    For Each y In ReportingRange 
     If x = y Then Match = True 
     If x = y Then Exit For 
    Next y 
    'If Match = False Then x.Offset(0, 1) = x 
    LastRow = thisBook.Worksheets("Sheet1").Range("a1").End(xlDown).Offset(1, 0) 
    If Match = False Then x.LastRow 
Next x 

Weekly_Data.Close 
Set Weekly_Data = Nothing 
Reporting.Close 
Set Reporting = Nothing 

Exit Sub 
Errorcatch: 
MsgBox Err.Description 
End Sub 

Answer 1

更仔細地看待代碼，有幾個問題。我固定他們在下面的代碼（注 - 爲簡單起見，我把三個大量的數據在一張紙上，但你可以把你自己的工作簿結構的背面，很明顯）

Sub Find_Matches() 

Dim CompareRange As Variant, x As Variant, y As Variant 
Dim ReportingRange As Variant 

Dim thisBook As Workbook 
Set thisBook = ThisWorkbook 

Dim Match As Boolean 

Dim Weekly_Data As Workbook 
Set Weekly_Data = ActiveWorkbook '<<<< changed for simplicity. Change back to what you need 
' Dim LastRow As Long <<< no longer used 

Dim Reporting As Workbook 
Set Reporting = ActiveWorkbook ' <<<< ditto 

' <<< new: set the first cell where output goes once, then move down when you write in it >>> 
Dim outputRange As Range 
Set outputRange = thisBook.Sheets("Sheet1").Range("C2") ' pick whatever the right spot is 

On Error GoTo Errorcatch 

Set CompareRange = Weekly_Data.Worksheets("Sheet1"). _ 
    Range("b2", Worksheets("Sheet1").Range("b2").End(xlDown)) ' <<< not .Value 

Set ReportingRange = Reporting.Worksheets("Sheet1"). _ 
    Range("a1", Worksheets("Sheet1").Range("a1").End(xlDown)) ' <<< not .Value 

For Each x In CompareRange 
    Match = False 
    For Each y In ReportingRange 
     If x = y Then Match = True 
     If x = y Then Exit For 
    Next y 
    If Match = False Then 
     outputRange.Value = x 
     Set outputRange = outputRange.Offset(1, 0) ' <<< so outputRange always points to next empty cell 
    End If 
Next x 

Weekly_Data.Close 
Set Weekly_Data = Nothing 
Reporting.Close 
Set Reporting = Nothing 

Exit Sub 
Errorcatch: 
MsgBox Err.Description 
End Sub 

這些變化使得代碼爲我工作。順便提一下，我建議您在嘗試調試時關閉On Error語句，以便在發生錯誤的行停止（而不是僅報告錯誤）。一旦你的代碼正在工作，你可以打開錯誤陷阱來防止意外情況發生。

有幾個地方可以進一步清理這個地方，但我認爲你已經有了很多的第一個VBA項目，所以我不想過度批評。