VBscript比較給定行的兩個Excel表中某些列的內容

Question

我是VB腳本編程的新手，請耐心等待。我有兩張表示舊數據庫和新數據庫的結構如下

A   B(key)  C  D  E  F 

837 | 15287RI0300002 |個人| SelectRI |直接|新計劃

A   B(key)  C  D  E  F  G  H 

837 | 15287RI0300002 |個人|評分1 | Rating2 | SelectRI |直接|新計劃

我必須根據關鍵比較一行的內容並突出顯示差異。現在問題是列沒有排序。因此我需要從一張到另一張的映射。

任何人都可以幫我一個VBScript嗎？請嘗試提供一個通用的解決方案，因爲我在工作簿中有多個工作表。

P.S.

1. 行不排序
2. 的片材是在單獨的工作簿
3. 這是沒有必要在舊片鍵總是在新的工作表存在。

Answer 1

由於舊數據庫和新數據庫中的列不相同，因此映射需要由您編寫。一種可能性是在單獨的工作表中製作一張表格，您可以在其中指定哪一列與哪一列相對應。很難維護，切換頁面並檢查。

另一種可能性是在新數據庫表的頂部插入一行，並將舊數據庫的列標題的名稱寫入其中。然後，您可以做這樣的事情（而下面的代碼假定您已經覆蓋而不是插入上面一行的頭，所以你可能需要適應這一點）

Sub compare() 

    'Lots of vars... 
    Dim shtOld As Worksheet, shtNew As Worksheet 
    Dim keyOld As Range, keyNew As Range 
    Dim rOld As Range, rNew As Range 
    Dim colOld As Range, colNew As Range 
    Dim numColsOld As Integer, numColsNew As Integer, i As Integer, k As Integer 

    'Set 
    Set shtOld = ThisWorkbook.Sheets(1) 
    Set shtNew = ThisWorkbook.Sheets(2) 
    numColsOld = shtOld.UsedRange.Columns.Count 
    numColsNew = shtNew.UsedRange.Columns.Count 

    'Loop column B of old DB 
    For k = 1 To shtOld.UsedRange.Rows.Count - 1 
     Set keyOld = shtOld.Range("B" & k + 1) 

     'Find key in other sheet (assuming key is always in B, 
     'else do a column search here as well, see below) 
     Set keyNew = shtNew.Range("B:B").Find(keyOld.Value, LookIn:=xlValues) 
     If Not keyNew Is Nothing Then 
      Debug.Print "Found key at: " & keyNew.Address 

      'Loop Cols 
      For i = 1 To numColsOld 
       Set colOld = shtOld.Cells(1, i) 'starting from A, the first to the left 
       'Find column header in New 
       Set colNew = shtNew.Range("A1:" & Cells(1, numColsNew).Address).Find(colOld.Value, LookIn:=xlValues) 
       If Not colNew Is Nothing Then 
        Debug.Print "Found Column at: " & colNew.Column 

        Set rOld = shtOld.Cells(keyOld.Row, colOld.Column) 
        Set rNew = shtNew.Cells(keyNew.Row, colNew.Column) 

        If rOld <> rNew Then rNew.Interior.ColorIndex = 24 

       End If 
       Set newcol = Nothing 
      Next i 

     End If 
     Set newkey = Nothing 

    Next k 

    'Cleanup 
    Set rOld = Nothing 
    Set rNew = Nothing 
    Set shtOld = Nothing 
    Set shtNew = Nothing 

End Sub