VBA - Vlookup 返回开发，但添加到功能区时不会

Question

我有一个奇怪的问题。

以下代码将使用 F8 或按开发模块上的"运行"按钮运行。

但是，当通过以下过程作为宏添加到 excel 功能区时，vlookup 将返回 #N/A ：

1.右键单击Excel工具栏>自定义功能区

2. 选择宏命令

3. 将其添加到新组。

代码是：

 Sub Compare()
'set primary Workbook
'find last cell'
    Dim WS As Worksheet
    Dim LastCell As Range
    Dim LastCellRowNumber As Long
    Set WS = Worksheets("Sheet1")
        With WS
        Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
        LastCellRowNumber = LastCell.Row
        'MsgBox (LastCell.Row)
    End With
'Adding Index Column
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
[A2].Formula = "=G2&H2"
Range("A2:A" & LastCellRowNumber).FillDown
'adding headers
[Ag1].Value = "Resale"
[Ah1].Value = "Cost"
[Ai1].Value = "disti"
'set primary Workbook
 Dim Pri As Workbook
 Set Pri = ActiveWorkbook
 'open company quotes
  Workbooks.Open ("R:companyDATAcompany quotes.xlsx")
 'find last cell'
    Dim WSq As Worksheet
    Dim LastCellq As Range
    Dim LastCellRowNumberq As Long
    Set WSq = Worksheets("Quote Summary")
        With WSq
        Set LastCellq = .Cells(.Rows.Count, "A").End(xlUp)
        LastCellRowNumberq = LastCellq.Row
        'MsgBox (LastCell.Row)
    End With
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Dim quotes As Workbook
Set quotes = ActiveWorkbook
[A2].Formula = "=J2&B2"
Range("A2:A" & LastCellRowNumberq).FillDown
Pri.Activate
Dim i As Integer
For i = 2 To LastCellRowNumber
Dim result As String
Dim sheet As Worksheet
Range("AG" & i) = Application.VLookup(Sheet1.Range("A" & i), Workbooks("company quotes.xlsx").Worksheets("Quote Summary").Range("A2:AS" & LastCellRowNumberq), 17, False)
Range("AH" & i) = Application.VLookup(Sheet1.Range("A" & i), Workbooks("company quotes.xlsx").Worksheets("Quote Summary").Range("A2:AS" & LastCellRowNumberq), 19, False)
Range("Ai" & i) = Application.VLookup(Sheet1.Range("A" & i), Workbooks("company quotes.xlsx").Worksheets("Quote Summary").Range("A2:AS" & LastCellRowNumberq), 20, False)

Next i

 End Sub

Answer 1

我试图解决我能找到的任何引用问题，但您需要浏览并确保所有Range引用都以正确的Workbook和Worksheet为前缀，因为不太清楚它们来自原始代码中的工作表：

Sub Compare()
'Set primary Workbook
'Find last cell
Dim WS As Worksheet
Dim LastCellRowNumber As Long
Set WS = ThisWorkbook.Sheets("Sheet1")
LastCellRowNumber = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row
'MsgBox (LastCell.Row)
'Adding Index Column
WS.Columns("A:A").Insert Shift:=xlToRight
WS.Range("A2:A" & LastCellRowNumber).Formula = "=G2&H2"
'adding headers
WS.Range("AG1").Value = "Resale"
WS.Range("AH1").Value = "Cost"
WS.Range("AI1").Value = "disti"
'open company quotes
Dim wbCompQuotes As Workbook
Set wbCompQuotes = Workbooks.Open ("R:companyDATAcompany quotes.xlsx")
'find last cell'
Dim wsQuoteSum As Worksheet
Dim LastCellRowNumberq As Long
Set wsQuoteSum = wbCompQuotes.Worksheets("Quote Summary")
LastCellRowNumberq = wsQuoteSum.Cells(wsQuoteSum.Rows.Count, "A").End(xlUp).Row
'MsgBox (LastCell.Row)
wsQuoteSum.Columns("A:A").Insert Shift:=xlToRight
wsQuoteSum.Range("A2:A" & LastCellRowNumberq).Formula = "=J2&B2"
Dim i As Long
For i = 2 To LastCellRowNumber
    WS.Range("AG" & i) = Application.VLookup(WS.Range("A" & i), wsQuoteSum.Range("A2:AS" & LastCellRowNumberq), 17, False)
    WS.Range("AH" & i) = Application.VLookup(WS.Range("A" & i), wsQuoteSum.Range("A2:AS" & LastCellRowNumberq), 19, False)
    WS.Range("AI" & i) = Application.VLookup(WS.Range("A" & i), wsQuoteSum.Range("A2:AS" & LastCellRowNumberq), 20, False)
Next i
End Sub