使用F5运行代码时,VBA无法将范围导入数组,但如果逐行(F8)运行,则将导入

时间:2018-11-23 16:19:37

标签: excel vba excel-vba

因此,正如标题所示,当与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 :(得分:2)

定义范围时,必须为每个范围/单元格添加一个图纸引用,否则将假定为活动图纸。

您的代码等同于

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

并且由于您引用两个不同的工作表而引起错误(除非Output是活动工作表)。

解决这个问题的最简洁的方法是使用With(我想btw也可以简化您的表达):

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