Question

我基本上是在使用三本工作簿。第一个是thisBook，一个运行宏，最终应该设置数据的那个。第二个是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项目你已经有很多权利，所以我不想批评过。

比较两个与操作工作簿分开的工作簿中的数据

1 个答案: