VBA в Excel: Ошибка выполнения 1004

Question

Я пытаюсь сделать следующее. У меня есть несколько таблиц, которые называются «ITT_198763», где часть ITT остается неизменной, но число меняется. У меня также есть одна вкладка, называемая программой, где 6-значный номер импортируется в строке 40 (следовательно, RngToSearch ниже). Мне нужна программа, чтобы 1) найти лист «ITT» для определенного 6-значного числа, 2) определить соответствующую строку на вкладке «Программа» и скопировать информацию со вкладки «ITT» в строку 41 идентифицированного столбца. Я буду копировать дополнительную информацию из листа ITT в указанный столбец, но сейчас я просто пытаюсь заставить его работать один раз.

Из MsgBox я знаю, что он идентифицирует правильный номер prjNumber (6-значное число), но я получаю ошибку времени выполнения 1004 в строке Set RngDest. Любая помощь будет оценена!

Sub Summary_Table() 

Dim wks As Worksheet 
Dim RngToSearch As Range, RngDest As Range 
Dim foundColumn As Variant 
Dim prjNumber 

For Each wks In ActiveWorkbook.Worksheets 

    If ((Left(wks.Name, 3) = "ITT")) Then 

    prjNumber = Right(wks.Name, 6) 
    MsgBox (prjNumber) 

    Set RngToSearch = Sheets("Program").Range("C40:q40") 
    foundColumn = Sheets("Program").Application.Match(prjNumber, RngToSearch, False) 

    With Sheets("Program") 
     Set RngDest = .Range(1, foundColumn) 'Project Name 
    End With 

    If Not IsError(foundColumn) Then 
     wks.Range("E2").Copy RngDest 
    End If 

    End If 

Next wks 


End Sub 

Я попробовал .cell вместо со следующим кодом (все остальное то же самое), и теперь получаю ошибку во время выполнения 13 на линии Set RngDest:

Set RngToSearch = Sheets("Program").Range("C40:q48") 
foundColumn = Sheets("Program").Application.Match(prjNumber, RngToSearch.Rows(1), False) 

With Sheets("Program") 
    Set RngDest = RngToSearch.Cells(1, foundColumn) 'Project Name 
End With 

Answer 1

Вы ищете функции Cells , который имеет прототип .Cells([RowIndex], [ColumnIndex]). Функция Range принимает либо строку с именем диапазона (например, "A1", либо именованным диапазоном), либо другими ссылками диапазона.

Answer 2

Yuo получает эту ошибку, потому что foundColumn имеет недопустимое значение. Пройдите код и посмотрите, что такое значение foundColumn

Вот пример, который работает.

Sub Sample() 
    Dim RngDest As Range, RngToSearch As Range 

    foundColumn = 1 

    Set RngToSearch = Sheets("Program").Range("C40:q40") 

    Set RngDest = RngToSearch.Cells(1, foundColumn) 

    Debug.Print RngDest.Address 
End Sub 

Добавить MsgBox foundColumn перед линией Set RngDest = RngToSearch.Cells(1, foundColumn) и увидеть, какое значение вы получаете. Я предполагаю, что линия

foundColumn = Sheets("Program").Application.Match(prjNumber, RngToSearch, False)

не дает вам нужное значение. Вот способ воспроизвести ошибку.

EDIT (Solution)

Вы должны справиться с ситуацией, когда нет совпадений не найдено. Попробуйте что-то вроде этого

Sub Sample() 
    Dim RngDest As Range, RngToSearch As Range 

    Set RngToSearch = Sheets("Program").Range("C40:q40") 

    foundcolumn = Sheets("Program").Application.Match(1, RngToSearch, False) 

    If CVErr(foundcolumn) = CVErr(2042) Then 
     MsgBox "Match Not Found" 
    Else 
     Set RngDest = RngToSearch.Cells(1, foundcolumn) 

     ' 
     '~~> Rest of the code 
     ' 
    End If 
End Sub 

Answer 3

Я понял! Столбец найден был проблемой. Объединив это с помощью других комментаторов, выполните следующие работы:

Sub Summary_Table() 

Dim wks As Worksheet 
Dim RngToSearch As Range, RngDest As Range 
Dim foundColumn As Variant 
Dim prjNumber 

For Each wks In ActiveWorkbook.Worksheets 

If ((Left(wks.Name, 3) = "ITT")) Then 

prjNumber = Right(wks.Name, 6) 
MsgBox (prjNumber) 

Set RngToSearch = Sheets("Program").Range("a40:q48") 
foundColumn = Sheets("Program").Rows(40).Find(what:=prjNumber, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False).Column 
MsgBox (foundColumn) 


With Sheets("Program") 
    Set RngDest = RngToSearch.Cells(2, foundColumn) 'Project Name 
    Debug.Print RngDest.Address 
End With 

If Not IsError(foundColumn) Then 
    wks.Range("E3").Copy RngDest 
End If 

End If 

Next wks 


End Sub