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

Question

我有一张工作簿，其中包含四张纸张 - 一张合并纸张，可从其他项目（工作表2-4）中提取所有信息。合并后的工作表将用作另一个Excel工作表的源文件，该工作表将用于编辑和更新无法从以下报表填充的字段（工作表2-4）。我无法使用Access或其他数据库类型来限制超出我的控制范围。

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

步骤1：集成数据来源表Sheet 3到合并表 - 作品

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：我需要在SQR匹配来自Consolidated_Sheet（柱U）为该值（柱J），然后将同一行SQR（列F）中的值复制到Consolidated_Sheet（列O）中对应的初始值行。 （CS-U）到（SQR-J）然后将（SQR-F）复制到（CS-O）。

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

我已经试图在小规模上取得有限的成功 - 一行，它的工作原理，但我找不到一种方法，使其在更大的数据集中工作（〜2,000 +行）。我在互联网上发现了这一点，这是我能找到的最接近的东西 - 我真的不知道我是否问过正确的方法。

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

你的第一部分是功能性的，但可以缩短相当多的（因此更容易维护），如果你使用一个小的子做实际的复制：

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子，所以你可以从Submission多次调用该方法，针对不同的参数：

• 要查找
• 列你想要哪一列检查，对
• 从哪里在比赛的情况下，挑值
• 把那个价值为

下面哪一列的代码：

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 

祝你好运！