简化以下vlookup

Simplify the following vlookup

我是 VBA 编程的初学者。我通过宏录制器录制了以下 vlookUp。我该如何缩短和简化代码?

ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],oldStockAge!C[-7]:C[1],8,0)"
    Range("J5").Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8],oldStockAge!C[-8]:C,9,0)"
    Range("D5:J5").Select
    Selection.AutoFill Destination:=Range("D5:J399")
    Range("D5:J399").Select

如果有人能提供帮助,我将不胜感激me.If您需要更多信息,请回来找我。

请尝试下一个快速函数,该函数能够将所有涉及范围的 Vlookup 结果放入数组中并立即删除其内容。我不明白 J5 单元格 (D5:I5) 之前发生了什么...代码 returns VLookup 导致第 J:J 列,从 J5:

开始
Sub OptimizedVlookup()
 Dim sh As Worksheet, shOld As Worksheet, lastR As Long, rngB As Range, rngBJ As Range, lastR2 As Long, arrVlk

   Set sh = ActiveSheet
   Set shOld = Worksheets("oldStockAge")
    lastR = sh.Range("B" & sh.rows.Count).End(xlUp).row
    lastR2 = shOld.Range("B" & sh.rows.Count).End(xlUp).row
    Set rngB = sh.Range("B5:B" & lastR)
    Set rngBJ = shOld.Range("B2:J" & lastR2)
    
    arrVlk = WorksheetFunction.VLookup(rngB, rngBJ, 9, False)

    sh.Range("J5").Resize(UBound(arrVlk), 1).Value = arrVlk
End Sub

不同版本:

Sub OptimizedVlookupMoreColsVersion2()
 Dim sh As Worksheet, shOld As Worksheet, lastR As Long, rngB As Range
 Dim rngBJ As Range, lastR2 As Long, arrVlk, iRow As Long, i As Long

   iRow = 5
   Set sh = ActiveSheet
   Set shOld = Worksheets("oldStockAge")
    lastR = sh.Range("B" & sh.rows.Count).End(xlUp).row
    lastR2 = shOld.Range("B" & sh.rows.Count).End(xlUp).row
    Set rngB = sh.Range("B" & iRow & ":B" & lastR)
    Set rngBJ = shOld.Range("B2:J" & lastR2)
    For i = iRow To lastR
        arrVlk = Application.IfError(Evaluate("=VLOOKUP(B" & i & "," & rngBJ.Address(external:=True) & ",{3,4,5,6,7,8,9},FALSE)"), "N/A")
        If TypeName(arrVlk) = "String" Then
             sh.cells(i, "D").Resize(1, 7).Value = "N/A"
        Else
            sh.cells(i, "D").Resize(1, UBound(arrVlk)).Value = arrVlk
        End If
    Next i
End Sub

为了写出VLookup公式,不是其结果,请尝试下一种方式:

Sub VlookupFormula()
 Dim sh As Worksheet, shOld As Worksheet, lastR As Long, rngB As Range, rngBJ As Range, lastR2 As Long

   Set sh = ActiveSheet
   Set shOld = Worksheets("oldStockAge")
    lastR = sh.Range("B" & sh.rows.Count).End(xlUp).row
    lastR2 = shOld.Range("B" & sh.rows.Count).End(xlUp).row
    Set rngB = sh.Range("B2:B" & lastR)
    Set rngBJ = shOld.Range("B2:J" & lastR2)

    sh.Range("J2:J" & lastR).Formula = "=VLOOKUP(B2," & rngBJ.Address(external:=True) & ",9,0)" 
End Sub

已编辑:

如果我正确理解了您的需要,下一个代码将放置能够 return 来自范围 "D:J":

的所有对应列的公式
Sub OptimizedVlookupMoreCols()
 Dim sh As Worksheet, shOld As Worksheet, lastR As Long, rngB As Range
 Dim rngBJ As Range, lastR2 As Long, arrVlk, iRow As Long, i As Long

   iRow = 5 'the row where from the data will be returned
   Set sh = ActiveSheet
   Set shOld = Worksheets("oldStockAge")
    lastR = sh.Range("B" & sh.rows.Count).End(xlUp).row
    lastR2 = shOld.Range("B" & sh.rows.Count).End(xlUp).row
    Set rngB = sh.Range("B" & iRow & ":B" & lastR)
    Set rngBJ = shOld.Range("B2:J" & lastR2)
    For i = 3 To 9
        arrVlk = WorksheetFunction.VLookup(rngB, rngBJ, i, False)
        sh.cells(iRow, i + 1).Resize(UBound(arrVlk), 1).Value = arrVlk
    Next i
End Sub

而下一个将为 return 相同的数据编写公式:

Sub VlookupFormulaMoreCols() 
 Dim sh As Worksheet, shOld As Worksheet, lastR As Long, rngB As Range
 Dim rngBJ As Range, lastR2 As Long, arrVlk, i As Long, iRow As Long

   iRow = 5
   Set sh = ActiveSheet
   Set shOld = Worksheets("oldStockAge")
    lastR = sh.Range("B" & sh.rows.Count).End(xlUp).row
    lastR2 = shOld.Range("B" & sh.rows.Count).End(xlUp).row
    Set rngB = sh.Range("B2:B" & lastR)
    Set rngBJ = shOld.Range("B2:J" & lastR2)
    'create the first range (row 5) Vlookup formulas:
    For i = 3 To 9
        sh.cells(iRow, i + 1).Formula = "=VLOOKUP(B2," & rngBJ.Address(external:=True) & "," & i & ",0)"
    Next i
    sh.Range("D" & iRow, "J" & iRow).AutoFill destination:=sh.Range("D" & iRow, "J" & lastR)
End Sub

请在测试后发送一些反馈 it/them。