Question

我是VBscripting的新手，所以请耐心等待。我有两张表示旧数据库和一个具有以下结构的新数据库

A          B(key)      C       D      E       F

837 | 15287RI0300002 |个人| SelectRI |直接|新计划

A          B(key)      C      D      E       F      G      H

837 | 15287RI0300002 |个人|评分1 |评分2 | SelectRI |直接|新计划

我必须根据键比较行的内容并突出显示差异。现在问题是列没有排序。因此，我需要从一张纸到另一张纸的映射。

任何人都可以帮我一个vbscript吗？请尝试提供一般解决方案，因为我在工作簿中有多个工作表。

P.S。

行未排序
工作表位于单独的工作簿中
旧表中的键不一定存在于新表中。

Answer 1

由于旧DB和新DB中的列不相同，因此需要由您编写映射。一种可能性是在单独的工作表中创建一个表，您可以在其中指定哪个列对应于哪个列。一种难以维护，一直切换纸张并检查。

另一种可能性是在新数据库的工作表顶部插入一行，并将旧数据库的列标题名称写入其中。然后你可以做这样的事情（而下面的代码假设你已经覆盖了标题而不是在上面插入一行，所以你可能需要调整它）

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

VBscript用于比较给定行的两个excel表中某些列的内容

1 个答案: