объектно-определяемая ошибка при использовании .Find для объединения таблиц в VBA - PullRequest
Новая
       40

объектно-определяемая ошибка при использовании .Find для объединения таблиц в VBA

1 голос
/ 27 января 2012

Я пытаюсь написать свой первый макрос с нуля.У меня есть набор из 16 таблиц на Листе 2 со столбцами в шаблоне: список идентификаторов, пусто, значение1, значение2, значение3, значение4, пусто, следующий список идентификаторов, пусто, значение1 и т. Д ...

Идентификаторы в каждой таблице уникальны, но не всегда одинаковы, поэтому я пытаюсь написать макрос для сопоставления идентификатора с полным списком идентификаторов, которые находятся на Листе1.Если есть совпадение, я хочу скопировать четыре столбца значений в нужное место на Листе 1.В противном случае просто вставьте несколько нулей.

Если вы уже не можете сказать, я новичок в этом и понятия не имею, что я делаю!Я получаю сообщение «Ошибка приложения или объекта» в строке, где я пытаюсь использовать. Нахожу, я был бы очень признателен, если бы кто-то мог указать, где я иду не так?

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

1 Ответ

1 голос
/ 27 января 2012

Ваша ключевая проблема в том, что эта строка Find на Листе 2 не соответствует 

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). Следовательно, ошибка, поскольку код не может найти столбец G (столбец 7), P (столбец 14) и т. Д., Начиная с A1

Если вы попробуете
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)

...