匹配两张纸张之间的值，并将相应的值复制到初始纸张两次

我有一张工作簿，里面有四张工作表 – 一张合并工作表，从其他项目中抽取所有信息（工作表2-4）。 合并后的工作表将用作另一个Excel工作表的源文件，用于编辑和更新无法从下面的报告（Sheet2-4）填充的字段。 我无法使用Access或其他数据库types做超出我的控制的限制。

Sheet1 : Consolidated_Sheet Sheet2 : Incentive_Report_Raw_Data Sheet3 : Offer_Report_Raw_Data Sheet4 : SQR_Report_Raw_Data 

步骤1：将Sheet3中的数据整合到合并工作表 – Works

 Sub InitialMigration() Dim sourceColumn As Range, targetColumn As Range Set sourceColumn = Worksheets("Offer_Report_Raw_Data").Columns("B") Set targetColumn = Worksheets("Consolidated_Sheet").Columns("D") sourceColumn.Copy [targetColumn] Set sourceColumn = Worksheets("Offer_Report_Raw_Data").Columns("AH") Set targetColumn = Worksheets("Consolidated_Sheet").Columns("H") sourceColumn.Copy [targetColumn] Set sourceColumn = Worksheets("Offer_Report_Raw_Data").Columns("AV") Set targetColumn = Worksheets("Consolidated_Sheet").Columns("L") sourceColumn.Copy [targetColumn] Set sourceColumn = Worksheets("Offer_Report_Raw_Data").Columns("AW") Set targetColumn = Worksheets("Consolidated_Sheet").Columns("M") sourceColumn.Copy [targetColumn] Set sourceColumn = Worksheets("Offer_Report_Raw_Data").Columns("D") Set targetColumn = Worksheets("Consolidated_Sheet").Columns("N") sourceColumn.Copy [targetColumn] Set sourceColumn = Worksheets("Offer_Report_Raw_Data").Columns("I") Set targetColumn = Worksheets("Consolidated_Sheet").Columns("O") sourceColumn.Copy [targetColumn] Set sourceColumn = Worksheets("Offer_Report_Raw_Data").Columns("AS") Set targetColumn = Worksheets("Consolidated_Sheet").Columns("P") sourceColumn.Copy [targetColumn] Set sourceColumn = Worksheets("Offer_Report_Raw_Data").Columns("BC") Set targetColumn = Worksheets("Consolidated_Sheet").Columns("W") sourceColumn.Copy [targetColumn] Set sourceColumn = Worksheets("Offer_Report_Raw_Data").Columns("AO") Set targetColumn = Worksheets("Consolidated_Sheet").Columns("Z") sourceColumn.Copy [targetColumn] Set sourceColumn = Worksheets("Offer_Report_Raw_Data").Columns("AN") Set targetColumn = Worksheets("Consolidated_Sheet").Columns("AB") sourceColumn.Copy [targetColumn] Set sourceColumn = Worksheets("Offer_Report_Raw_Data").Columns("AK") Set targetColumn = Worksheets("Consolidated_Sheet").Columns("Y") sourceColumn.Copy [targetColumn] Set sourceColumn = Worksheets("Offer_Report_Raw_Data").Columns("AM") 'Pricing Set targetColumn = Worksheets("Consolidated_Sheet").Columns("AD") sourceColumn.Copy [targetColumn] Set sourceColumn = Worksheets("Offer_Report_Raw_Data").Columns("F") 'Campaign Owner Set targetColumn = Worksheets("Consolidated_Sheet").Columns("I") sourceColumn.Copy [targetColumn] Set sourceColumn = Worksheets("Offer_Report_Raw_Data").Columns("AG") 'Product Set targetColumn = Worksheets("Consolidated_Sheet").Columns("F") sourceColumn.Copy [targetColumn] End Sub 

步骤2：我需要将来自Consolidated_Sheet（U列）的值与SQR（J列）中的值相匹配，然后将同一行SQR（F列）中的值复制到Consolidated_Sheet（O列）中对应的初始值的行中。 将（CS-U）与（SQR-J）匹配，然后将（SQR-F）复制到（CS-O）。

注意：两张不同纸张上的行不匹配。

我试图在小范围内取得有限的成功 – 一行，它的工作原理，但我找不到一个方法，使其在更大的数据集（〜2000 +行）之间工作。 我在互联网上发现了这一点，这是我能find的最接近的东西 – 我真的不知道我是否问过正确的方法。

 Sub Submission() Set wks1 = Worksheets("Consolidated_Sheet") Set wks2 = Worksheets("SQR_Report_Raw_Data") With wks1 End With If wks1.Range("U") = wks2.Range("J") Then wks2.Range("F").Copy wks1.Range("O") '<< cpy to 2nd WS End If End Sub 

步骤3： Consolidated_Sheet和Incentive_Report_Raw_Data之间需要前面练习的要求。

请注意，这些原始数据表将每周更新一次，我会说这是为了能够不断更新一切。 理想的是一步一步的过程。

Answer 1

你的第一部分是function性的，但是如果你使用一个小的Sub来做实际的复制的话，它可以缩短很多（所以维护更容易）：

 Sub InitialMigration() CopyColumn "B", "D" CopyColumn "AH", "H" CopyColumn "AV", "L" CopyColumn "AW", "M" CopyColumn "D", "N" CopyColumn "I", "O" CopyColumn "AS", "P" CopyColumn "BC", "W" CopyColumn "AO", "Z" CopyColumn "AN", "AB" '...ETC ETC End Sub 'Utility sub: Copy col letter S to col letter D Sub CopyColumn(S As String, D As String) Worksheets("Offer_Report_Raw_Data").Columns(S).Copy _ Worksheets("Consolidated_Sheet").Columns(D) End Sub 

最后一部分有点复杂，但在下面的例子中，所有的逻辑都在DoLookup Sub中，所以你可以从Submission重复调用它，其中不同的参数为：

• 你想查找的列
• 你想检查哪一列
• 在比赛的情况下从哪里select价值
• 将该值放入的列

代码如下：

 Sub Submission() Dim wksCS As Worksheet, wksSQR As Worksheet Set wksCS = Worksheets("Consolidated_Sheet") Set wksSQR = Worksheets("SQR_Report_Raw_Data") 'look up colU against colJ - copy match from ColF to ColO DoLookup wksCS.Columns("U"), wksSQR.Columns("J"), "F", "O" 'add more lookups here.... End Sub 'Utility: for each value in SrcCol, check MatchCol for a match. ' If found, copy the value from Col 'ValCol' on the matched row to Col 'DestCol' on ' the consolidation sheet. Sub DoLookup(SrcCol As Range, MatchCol As Range, ValCol As String, DestCol As String) Dim rngSrc As Range, rngMatch As Range, c As Range, v, m 'just work with the "used" parts of the match columns Set rngSrc = Application.Intersect(SrcCol, SrcCol.Parent.UsedRange) Set rngMatch = Application.Intersect(MatchCol, MatchCol.Parent.UsedRange) For Each c In rngSrc.Cells v = c.Value If Len(v) > 0 Then m = Application.Match(v, rngMatch, 0) If Not IsError(m) Then c.EntireRow.Cells(1, DestCol).Value = _ rngMatch.Cells(m).EntireRow.Cells(1, ValCol) Else 'decide what you want to do here... c.EntireRow.Cells(1, DestCol).Value = "No match!" End If End If Next c End Sub 

祝你好运！