匹配兩張紙張之間的值並將相應的值複製到初始紙張兩次

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 

祝你好運！