VBA到VLOOKUP數據透視表中的值，以在輸出工作表的多列中返回值

Question

我有兩片，一個是片Data Sheet與不同公司的數據透視表。 我有另一個工作表Output Sheet ，數據表中的列標題很少，我想使用公司ID來vlookup不同的列標題。 我發現了以下代碼，並且可以很好地映射公司名稱，但是存在以下問題

1. 即使companyID僅在9555行之前可用，該公式companyID運行到100000行，然后顯示＃N #N/A

2. 如何使此公式查找其他列標題，例如細分，部門等。

需要映射的列標題：

Sub MakeFormulas()
    Dim SourceLastRow As Long
    Dim OutputLastRow As Long
    Dim sourceBook As Workbook
    Dim sourceSheet As Worksheet
    Dim outputSheet As Worksheet
    Application.ScreenUpdating = True

    'Where is the source workbook?
    Set sourceBook = Workbooks.Open("C:\Users\AAA\Desktop\NewFolder\Automation\07-Macro.xlsb")

    'what are the names of our worksheets?
    Set sourceSheet = sourceBook.Worksheets("TERFYTDPR")
    Set outputSheet = ThisWorkbook.Worksheets("All TMS-Data")

    'Determine last row of source
    With sourceSheet
        SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    With outputSheet
        'Determine last row in col B
        OutputLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
        'Apply our formula
        .Range("B2:B10000" & OutputLastRow).Formula = _
            "=VLOOKUP(A2,'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$B$" & SourceLastRow & ",2,0)"
        OutputLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
    End With

    'Close the source workbook, don't save any changes
    sourceBook.Close False
    Application.ScreenUpdating = True
End Sub

Answer 1

我們不知道您要對Vlookup進行工作的工作表上的數據布局，只是想我會解釋一下Vlookup：

=VLOOKUP(A2,'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$B$" & SourceLastRow & ",2,0)"

上面的代碼行中的最后一個數字2表示如果A2的內容匹配，您要返回的列號，您可以更改此值以獲得另一個列號，例如第三列的3，但是您也應該更改從$ A $ 2：$ B $查找的范圍，以包括其他列。

因此，例如，如果您的細分列位於列C中，則可以這樣更改vlookup：

=VLOOKUP(A2,'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$C$" & SourceLastRow & ",3,0)"

我還將重新編寫您的代碼，如下所示：

Sub MakeFormulas()
Dim SourceLastRow As Long, OutputLastRow As Long, i As Long
Dim sourceBook As Workbook
Dim sourceSheet As Worksheet, outputSheet As Worksheet

Application.ScreenUpdating = True
'Where is the source workbook?
Set sourceBook = Workbooks.Open("C:\Users\AAA\Desktop\NewFolder\Automation\07-Macro.xlsb")

'what are the names of our worksheets?
Set sourceSheet = sourceBook.Worksheets("TERFYTDPR")
Set outputSheet = ThisWorkbook.Worksheets("All TMS-Data")

'Determine last row of source
SourceLastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row

'Determine last row in col B
OutputLastRow = outputSheet.Cells(outputSheet.Rows.Count, "A").End(xlUp).Row
'Apply our formula
For i = 2 To OutputLastRow
    outputSheet.Range("B" & i).Formula = "=VLOOKUP(A" & i & ",'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$C$" & SourceLastRow & ",2,0)"
    outputSheet.Range("C" & i).Formula = "=VLOOKUP(A" & i & ",'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$C$" & SourceLastRow & ",3,0)"
'if segment is found in column C, and you also want the results in column C the line above will return the desired value
Next i
'Close the source workbook, don't save any changes
sourceBook.Close False
Application.ScreenUpdating = True
End Sub

更新：

要不循環地執行相同操作：

Sub MakeFormulas()
Dim SourceLastRow As Long, OutputLastRow As Long, i As Long
Dim sourceBook As Workbook
Dim sourceSheet As Worksheet, outputSheet As Worksheet

Application.ScreenUpdating = True
'Where is the source workbook?
Set sourceBook = Workbooks.Open("C:\Users\AAA\Desktop\NewFolder\Automation\07-Macro.xlsb")

'what are the names of our worksheets?
Set sourceSheet = sourceBook.Worksheets("TERFYTDPR")
Set outputSheet = ThisWorkbook.Worksheets("All TMS-Data")

'Determine last row of source
SourceLastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row

'Determine last row in col B
OutputLastRow = outputSheet.Cells(outputSheet.Rows.Count, "A").End(xlUp).Row
'Apply our formula
outputSheet.Range("B2:B:" & OutputLastRow).Formula = "=VLOOKUP(A2,'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$C$" & SourceLastRow & ",2,0)"
outputSheet.Range("C2:C" & OutputLastRow).Formula = "=VLOOKUP(A2,'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$C$" & SourceLastRow & ",3,0)"
'if segment is found in column C, and you also want the results in column C the line above will return the desired value

'Close the source workbook, don't save any changes
sourceBook.Close False
Application.ScreenUpdating = True
End Sub

Answer 2

據我了解，您希望將VLOOKUP公式填充到表中，但僅適用於數據在哪里的行？

假設始終填充列“ A”（公司ID）和“ B”（公司名稱），並且記錄之間沒有空隙，您可以使excel為您拖動公式

這是給你的代碼

Sub test()

Dim maxRow As Long
Dim DataWS As Worksheet
Dim lookupWS As Worksheet

'Set your data sheet
Set DataWS = Worksheets("Sheet1")
'Set your lookup sheet
Set lookupWS = Worksheets("Sheet2")

maxRow = lookupWS.Range("A1").End(xlDown).Row

'Populate formula
'Company Name
lookupWS.Range("B2").Formula = "=VLOOKUP($A2," & DataWS.Name & "!$A:$F,2,FALSE)" 'Make sure you change "2" to correct value in your case
'Segment
lookupWS.Range("C2").Formula = "=VLOOKUP($A2," & DataWS.Name & "!$A:$F,3,FALSE)" 'Make sure you change "3" to correct value in your case
'Sector
lookupWS.Range("D2").Formula = "=VLOOKUP($A2," & DataWS.Name & "!$A:$F,4,FALSE)" 'Make sure you change "4" to correct value in your case
'Channel
lookupWS.Range("E2").Formula = "=VLOOKUP($A2," & DataWS.Name & "!$A:$F,5,FALSE)" 'Make sure you change "5" to correct value in your case
'Account Type
lookupWS.Range("F2").Formula = "=VLOOKUP($A2," & DataWS.Name & "!$A:$F,6,FALSE)" 'Make sure you change "6" to correct value in your case

'Drag formula
Range("B2:F2").AutoFill Destination:=Range("B2:F" & maxRow), Type:=xlFillCopy


End Sub

確保適當地更改range數組，並且該數組應該適合您。