VBA не может импортировать диапазон в массив, когда код запускается с F5, но он будет, если он запускается построчно (F8) - PullRequest
0 голосов
/ 23 ноября 2018

Таким образом, как видно из заголовка, при запуске с F5 написанный мной код VBA выдает ошибку всякий раз, когда достигает строки, в которой необходимо импортировать диапазон в двумерный массив:

Vendor = wb.Sheets("Output").Range(Cells(1, 1), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2)).Value2

Однако при каждом построчном выполнении (F8) код VBA вообще не выдает никакой ошибки.

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

Это странное поведение, я понятия не имею, как его объяснить.

Я быценим вашу помощь.

Спасибо

Option Explicit
Sub VendorFinder()

'variable declaration
Dim msg As String
Dim ans As Integer
Dim rng As Range
Dim DescRng As Range
Dim DescCol As Range
Dim VendorCol As Range
Dim j As Long
Dim Vendor As Variant
Dim wb As Workbook
Dim sFile As String
Dim myVendor As Variant
Dim FirstRow As Range
Dim VendorRng As Range
Dim r&, cnt&
Dim rangeroo As Range, rngRow As Range

On Error GoTo BadEntry

TryAgain:

'set columns
Set DescCol = Application.InputBox("Select Description Column", "Obtain Object Range", Type:=8)
Set VendorCol = Application.InputBox("Select Vendor Column", "Obtain Object Range", Type:=8)
Set FirstRow = Application.InputBox("Select First Row with Data", "Obtain Object Range", Type:=8)

'set ranges
Set DescRng = Range(Cells(FirstRow.Row, DescCol.Column), Cells(Cells(Rows.Count, DescCol.Column).End(xlUp).Row, DescCol.Column))
Set VendorRng = Range(Cells(FirstRow.Row, VendorCol.Column), Cells(Cells(Rows.Count, DescCol.Column).End(xlUp).Row, VendorCol.Column))
myVendor = VendorRng.Value2

'import vendors
sFile = "D:\Desktop\Vendor List.xlsx"
Application.ScreenUpdating = False
Set wb = Application.Workbooks.Open(sFile)
Set rangeroo = wb.Sheets("Source").Range("A1").CurrentRegion
r = 1
For Each rngRow In rangeroo.Rows
    cnt = WorksheetFunction.CountA(rngRow.Cells)
    With wb.Sheets("Output").Cells(r, 1).Resize(cnt)
        .Value = rngRow.Cells(1).Value
        .Offset(, 1).Value = Application.Transpose(rngRow.Resize(, cnt).Value)
    End With
    r = r + cnt
Next

Vendor = wb.Sheets("Output").Range(Cells(1, 1), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2)).Value2

wb.Close False
Application.ScreenUpdating = True

For Each rng In DescRng

    If Cells(rng.Row, VendorCol.Column).Value = "" Then

        For j = LBound(Vendor) To UBound(Vendor)

            If InStr(1, rng.Value, Vendor(j, 2), vbTextCompare) > 0 Then
                myVendor(rng.Row - FirstRow.Row + 1, 1) = Vendor(j, 1)

        Exit For

            End If

        Next j

    End If

Next rng

VendorRng.Resize(UBound(myVendor) - LBound(myVendor) + 1, 1) = myVendor

Exit Sub

BadEntry:

msg = "You have clicked on cancel for one of the prompts."
msg = msg & vbNewLine
msg = msg & "Do you wish to try again?"
ans = MsgBox(msg, vbRetryCancel + vbExclamation)
If ans = vbRetry Then Resume TryAgain

End Sub

1 Ответ

0 голосов
/ 23 ноября 2018

Когда вы определяете диапазон, вы должны добавить ссылку на лист для каждого диапазона / ячеек, в противном случае предполагается наличие активного листа.

Ваш код эквивалентен

Vendor = wb.Sheets("Output").Range(activesheet.Cells(1, 1), activesheet.Cells(activesheet.Cells(Rows.Count, 2).End(xlUp).Row, 2)).Value2

и возникает ошибкапотому что вы ссылаетесь на два разных листа (если только «Вывод» не является активным листом).

Лучший способ обойти это - использовать «С» (я думаю, что btw также может упростить ваше выражение):

With wb.Sheets("Output")
    Vendor = .Range(.Cells(1, 1), .Cells(.Rows.Count, 2).End(xlUp)).Value2
End With
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...