Question

下面的代码没有运行。对所有人做得不好。请让我知道，如果你有任何问题。愿意分享文件。

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

如果输出表E列包含文本“PO人工或PO材料”，则执行Vlookup，否则跳过。 Vlookup将源表中的PO月度预测与输出表匹配。值必须与月份匹配。循环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

（输出表和源表单击下一个图像）http://imgur.com/SHANSLF&ydjQfb3#0

Answer 1

最后在这个社区的几位慷慨成员和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

VBA精益编码：动态多张表Vlookup嘉豪

1 个答案: