Правильно ли передать cell.value из диапазона в другое sub? - PullRequest
2 голосов
/ 13 мая 2019

У меня есть следующий код:

Dim WS1, WS2 As Worksheet
Dim chatRange As Range
Dim cell As Range
Dim txt As String

Sub NameTest()

    Set WS1 = ActiveWorkbook.Sheets("Page 1")
    Set WS2 = ActiveWorkbook.Sheets("Sheet1")
    x = 2
    lRow1 = WS1.Cells(Rows.Count, "B").End(xlUp).Row

    Set chatRange = WS1.Range("B" & x, "B" & lRow1)

    For Each cell In chatRange
        If cell.Offset(0, 11).Value = "Accepted" Then
            txt = cell.Offset(0, 18).Value
            NameSplit
        End If

    Next cell

End Sub

Sub NameSplit()
    Dim i As Integer
    Dim FullName As Variant
    Dim x As String, cell As Range
    Dim lRow2 As Long

    FullName = RemoveBlankLines(Split(txt, vbLf))
    lRow2 = WS2.Cells(Rows.Count, 2).End(xlUp).Row + 1
    WS2.Cells(lRow2, 1).Value = cell.Value                 <===================
    WS2.Cells(lRow2, 2).Value = cell.Offset(0, 2).Value    <===================
    WS2.Cells(lRow2, 3).Value = cell.Offset(0, 6).Value    <===================
    WS2.Cells(lRow2, 4).Value = cell.Offset(0, 18).Value   <===================
End Sub

Это часть простого тестового кода, который я пишу, чтобы прочитать один лист и затем передать требуемую информацию на другой лист. Я хочу иметь возможность использовать информацию из «ячейки» в диапазоне, который был установлен в первом подпрограмме, для передачи деталей во втором подпункте. Он работает с объявлением WS1 и WS2 вверху, но не работает для диапазонов.

4 строки, в которых есть стрелки, - это часть, которую я пытаюсь заставить работать, когда возвращается cell.value:

Run-time error '91': Object variable or With block variable not set

Я знаю, что наилучшим способом было бы иметь все это в 1 подпункте, но я бы хотел разделить его, если это возможно

ура заранее

Ответы [ 2 ]

3 голосов
/ 13 мая 2019

Всегда используйте Option Explicit, хотя в этом случае это не выявило бы проблему.

Как уже говорилось ранее, вы объявили cell в качестве диапазона (второй раз в функции NameSplit), ноникогда не устанавливайте это.Вот почему вы получаете ошибку, по крайней мере ..

Как уже упоминалось, вы можете легко передать эти значения в другую подпрограмму, если вы сначала объявите их.См. Пример (непроверенный) код, основанный на вашем:

Option Explicit
'Use global variables only if really needed, but was a good try.

Sub NameTest()
    Dim WS1 As Worksheet, WS2 As Worksheet
    Dim chatRange As Range
    Dim cell As Range
    Dim txt As String

    Set WS1 = ActiveWorkbook.Sheets("Page 1")
    Set WS2 = ActiveWorkbook.Sheets("Sheet1")

    x = 2

    lRow1 = WS1.Cells(WS1.Rows.Count, "B").End(xlUp).row

    Set chatRange = WS1.Range("B" & x, "B" & lRow1)

    For Each cell In chatRange
        If cell.Offset(0, 11).Value = "Accepted" Then
            txt = cell.Offset(0, 18).Value
            Call NameSplit(WS2, cell, txt)
        End If

    Next cell

End Sub

Sub NameSplit(wsDest As Worksheet, rngCell As Range, strTxt As String)    'You can pass any objects through. By default they are passed ByRef (search for ByRef vs ByVal)
    Dim i As Integer
    Dim FullName As Variant
    Dim x As String
    Dim lRow2 As Long

    FullName = RemoveBlankLines(Split(strTxt, vbLf))
    lRow2 = WS2.Cells(WS2.Rows.Count, 2).End(xlUp).row + 1

    wsDest.Cells(lRow2, 1).Value = rngCell.Value
    wsDest.Cells(lRow2, 2).Value = rngCell.Offset(0, 2).Value
    wsDest.Cells(lRow2, 3).Value = rngCell.Offset(0, 6).Value
    wsDest.Cells(lRow2, 4).Value = rngCell.Offset(0, 18).Value
End Sub

РЕДАКТИРОВАТЬ: Полностью квалифицированный Rows.Count до WS1.Rows.Count и соответственно WS2.Rows.Count для предотвращения ошибок и исправления кзначение по умолчанию в комментарии.(спасибо @chris neilsen за указание).

1 голос
/ 13 мая 2019

Ваша NameSplit() процедура должна быть объявлена ​​так:

Sub NameSplit(WS2 as Worksheet, cell as Range)
'
'
'your code here
'
'
End Sub

И это следует называть так:

call NameSplit(WS2, cell)

Вы можете удалить cell as Range из ваших объявлений в NameSplit()

...