Поиск и копирование с другого листа - PullRequest
0 голосов
/ 08 марта 2019

Я пытаюсь создать функцию, которая на основе данных из одного листа будет искать другой для сравнения и копировать из него в первый.

Это моя функция:

Sub kopiuj()
    Dim row As Long
    Dim copyRng As Range, pasteRng As Range

    row = 7
    If IsEmpty(Cells(row, 3)) Then
        MsgBox "Error1"
        Exit Sub
    End If
    Do Until IsEmpty(Cells(row, 3))
     If IsEmpty(Cells(row, 6)) And Cells(row, 5) = "cond" Then
          MsgBox "Error2"
           Exit Sub
     End If
     copyRng = szukaj2(Cells(row, 5).Value, Cells(row, 6).Value)
     Set pasteRng = Range(Cells(row, 8), Cells(row, 25))
     copyRng.Copy pasteRng
     row = row + 1
    Loop

End Sub

Function szukaj2(ByVal pp As String, ByVal p As String) As Range
  Dim PN As Worksheet
  Dim row As Integer
  Set PN = ActiveWorkbook.Sheets("PN")

  If pp <> "cond1" And pp <> "cond2" Then pp = "sth"
  For row = 7 To PN.Cells(Rows.Count, 4).End(xlUp).row Step 1
   If StrComp(pp, PN.Cells(row, 3).Value, vbTextCompare) = 0 And StrComp(p, PN.Cells(row, 1).Value, vbTextCompare) = 0 Then
    Set szukaj2 = PN.Range(PN.Cells(row, 8), PN.Cells(row, 25))
    Exit For
   End If
  Next
End Function

Я получаю ошибку 91

ошибка времени выполнения «Переменная объекта или переменная блока не установлена»

1 Ответ

0 голосов
/ 09 марта 2019

Ваша ошибка появится в этой строке кода

copyRng = szukaj2(Cells(row, 5).Value, Cells(row, 6).Value)

Вам необходимо использовать Set с объектными переменными. Измените эту строку кода на:

 Set copyRng = szukaj2(Cells(row, 5).Address, Cells(row, 6).Address)

Тогда все должно работать нормально.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...