使用 .Find 合并 VBA 中的表时出现对象定义错误

Question

我正在尝试从头开始编写我的第一个宏。我在 Sheet2 上有一组 16 个表，模式中的列：ID 列表、空白、value1、value2、value3、value4、空白、下一个 ID 列表、空白、value1 等...

每个表中的 ID 都是唯一的，但每次都不相同，因此我正在尝试编写一个宏来将 ID 与 Sheet1 上的完整 ID 列表相匹配。如果有匹配项，我想将四个值列复制到 Sheet1 上的正确位置。否则只需输入一些零。

如果你还不能说，我是新手，不知道我在做什么！我越来越 在我尝试使用 .Find 的行上出现“应用程序定义或对象定义的错误”，如果有人能指出我哪里出错了，我将不胜感激？

Sub Macro1()

Dim i As Integer
Dim y As Integer
Dim index As Long
Dim UniverseCount As Integer
Dim ID As String
Dim Position As Range


'Count total number of IDs    
Sheets("Sheet1").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
UniverseCount = Selection.Rows.Count


'Search loop
For y = 0 To 16
For i = 0 To UniverseCount


'Pick ID to look for
Sheets("Sheet1").Select
Range("A2").Offset(i, 0).Select
ID = Selection.Value

With Sheet2
Set Position = .Columns(7 * y).Find(What:=ID, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)

    If Not Position Is Nothing Then
    Position.Offset(0, 2).Select
    Range(Selection, Selection.End(xlRight)).Select
    Selection.Copy
    Sheets("Sheet1").Range("A2").Offset(i, 2 + 4 * y).Select
    ActiveSheet.Paste

    Else
    Sheets("Sheet1").Select
    Range("A2").Offset(i, 2 + 4 * y).Select
    Set Range(Selection, Selection.Offset(0, 4)).Value = 0

    End If
End With

Next i
Next y

End Sub

Answer 1

您的关键问题是 Sheet2 上的 Find 行不一致

Set Position = .Columns(7 * y).Find(What:=ID, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)

代码从 0 迭代到 16（大概应该是 1 到 16），但您的断开连接是您在 .Columns(7 * y) 中搜索的列是变量，即 0、7、14 但是您每次都尝试使用After:=.Cells(1, 1) 在A1 中开始搜索。因此，由于代码无法从 A1 开始搜索列 G（第 7 列）、P（第 14 列）等，因此出现错误

如果你尝试
Set Position = .Columns(7 * y).Find(What:=ID, After:=.Cells(1, 7 * y), LookIn:=xlValues, LookAt:=xlWhole)
那么您的搜索将在同一列上保持内部一致

下一步是删除Select 语句以获得更高效的代码。:)

第 2 部分） 正如您发现Postion 没有激活您需要的工作表

1) 激活位置
2) 完全避免Select

让我们开始 (2)

尝试替换

Position.Offset(0, 2).Select
Range(Selection, Selection.End(xlRight)).Select
Selection.Copy
Sheets("Sheet1").Range("A2").Offset(i, 2 + 4 * y).Select
ActiveSheet.Paste

与

Range(Position.Offset(0, 2), Position.Offset(0, 2).End(xlToRight)).Copy Sheets("Sheet1").Range("A2").Offset(i, 2 + 4 * y)