Таким образом, как видно из заголовка, при запуске с 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