Excel VBA精益编码：动态多页Vlookup Galore

下面的代码没有运行。做得很差。如果你有任何问题，请告诉我。愿意分享文件

简而言之，我想做的是： 源工作表包含按月的采购订单预测。输出工作表更有条理，位置相同，但格式不同。在你的大脑开始受伤之前，检查下面的屏幕截图链接。我需要将源表上按月预测的每月采购订单（代表采购订单）与输出表上按月预测的采购订单相匹配

如果输出表E列包含文本“采购订单人工或采购订单材料”，则执行Vlookup，否则跳过。Vlookup将源表中的采购订单月度预测与输出表相匹配。值必须与月份匹配。循环if-then函数，直到输出表结束。完成后，复制并粘贴定义输出vlookup范围内的任何单元格，以复制并粘贴值，以减少多次编码。最后你会看到屏幕截图

Sub NB_Run_Forecast_Upload()

Dim rng1 As Range   'Source Sheet this will set the range in which you want this formula to appear
Dim cl1 As Range
Dim rng2 As Range   'Output Sheet
Dim cl2 As Range    'Output Sheet
Dim rng3 As Range   'Outsheet Range for If Then Statement. Col C must have either "PO Labor" or "PO Materials" to execute Vlookup otherwise skip

Dim strFormula1 as String  `string to hold the formula text
Dim SourceLastRow As Long
Dim OutputLastRow As Long
Dim sourceSheet As Worksheet
Dim outputSheet As Worksheet
Dim DataValidation As Worksheet

Set sourceSheet = Worksheets("NB & COAX PO Detail test")
Set outputSheet = Worksheets("New Build & Coax test")
Set DataValidation = Worksheets("Data Validation")

Set rng1 = sourceSheet.Range("I5:AB1339")   'Range hardcoded; need it to go to end
Set rng2 = outputSheet.Range("G1:R5000")    'Range hardcoded; need it to go to the end of rng3
Set rng3 = output.Sheet.Range("C1:C5000")   'Range for If Then statement

'nothing happens in sourceSheet.  it is basically, the area where information is stored for vlookup

On Error Resume Next
With sourceSheet  'this might be a double declaration as rng1 does declare
    SourceLastRow = .Cells(.Rows.Count, "I").End(xlUp).Row
End With

With outputSheet


'if statement to check if Col C contains either "PO Labor" or "PO Materials"
For Each cl1 In rng2 'my translation:  for each cell in rng2 perform the below

If rng3.Value = "PO Materials" Then  'i would prefer to add OR statement to add "PO Labor" reduce redundancy

cl2.Forumla = MyLookupFormula

Else

If rng3.Value = "PO Labor" Then

c2.Forumla = MyLookupFormula

End If
Next rng2 'next col same row until after same row Col R it goes down the row in the outputsheet
End With



Function Colindexnum() As Integer   'i coded the Col number referenec for each month in the Outputsheet that corresponds to the same month in the Sourcesheet
                                    'it's similar to =vlookup(A1, A2:C2, ColIndexNum,0) ColIndexNum changes to each month, its constant in the outputsheet but changes in the sourcesheet
                                    'because every time period a month is deleted.  final range is till Dec

Colindexnum = (Application.WorksheetFunction.VLookup(outputSheet.Range("G3:R3"), DataValidation.Range("H30:I41"), 2, False))

End Function

Function MyLookupFormula() As Variant

If Not IsError(Application.WorksheetFunction.VLookup(outputSheet.Range("E:E"), rng1, Colindexnum, False)) Then
MyLookupFormula = (Application.WorksheetFunction.VLookup(outputSheetRange("E:E"), rng1, Colindexnum, False))


Else: MyLookupFormula = vbNullString
End Function

'after each lookup I want to copy and paste the cell it looked up to avoid too much coding Rng2
With outputSheet

For Each rng2 In .UsedRange
    If rng2.Formula Like "*VLOOKUP*" Then rng2.Formula = rng2.Value
    Next rng2
End With

End Sub

---

（输出表和源表单击下一张图片）

在这个社区和Chandoo的几个普通成员的帮助下，最终完成了这项工作。这是我编写的最后一段代码，它实际上是有效的

Sub MakeFormulas()
Dim SourceLastRow As Long
Dim OutputLastRow As Long
Dim sourceSheet As Worksheet
Dim outputSheet As Worksheet
Dim X As Long
Dim Z As Long

'What are the names of our worksheets?
Set sourceSheet = Worksheets("Sheet1")
Set outputSheet = Worksheets("Sheet2")


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

    'Determine last row in col C
  OutputLastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For y = 17 To 28 'Q to AB
  For X = 2 To OutputLastRow
  If InStr(1, .Range("C" & X), "PO Materials") + InStr(1, .Range("C" & X), "PO Labor") > 0 And Cells(2, y) = "Forecast" Then
  'Apply  formula
  .Cells(X, y).Value = _
  Evaluate("=VLOOKUP($E" & X & ",'" & sourceSheet.Name & "'!$A$2:$L$" & SourceLastRow & ",Match(" & Cells(1, y).Address & ",'" & sourceSheet.Name & "'!$A$1:$AD$1,0),0)")
  End If
  Next
Next

End With
End Sub

---

请你澄清一下你的问题是什么？除非你只是想让我们回答你是否疯了…；）“下面的代码未运行。”确定-首先删除错误恢复时的，然后继续下一步，并描述您遇到的错误以及在哪一行上出现的错误。首先，如果您想使用

IsError（）

测试返回值，您需要删除

工作表函数

，只需使用（eg）

应用程序即可。VLookup（…）

子系统中定义了嵌套函数，VBA不支持该功能。