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

Question

我正在尝试从头开始编写我的第一个宏。我在 Sheet2 上有一组 16 个表，其模式中的列为：ID 列表、空白、值 1、值 2、值 3、值 4、空白、下一个 ID 列表、空白、值 1 等...

每个表中的 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 但是您正尝试在 A1每次都使用 After:=.Cells(1, 1)。因此，错误是因为代码无法搜索从 A1 开始的 G 列（第 7 列）、P（第 14 列）等

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

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

第 2 部分)
由于您在未激活工作表的情况下找到了Postion，因此您需要

1) 激活 Position
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))。复制工作表("Sheet1").Range("A2").Offset(i, 2 + 4 * y)