用于比较单元格值的VBA代码

时间:2016-05-11 08:38:45

标签: excel vba excel-vba

我有3个工作表(基础)和一个主工作表(母版)来与之比较。

对于每个基本工作表,我需要将Col H(例如)的每一行中的字符串值与Col G(例如)的主工作表中的每一行进行比较。如果整个col G中不存在字符串值,则必须将基础工作表中的行复制到主工作表。

TIA!

1 个答案:

答案 0 :(得分:1)

我认为使用工作表函数很容易匹配如果项目不存在则会出错,因此我们处理错误。这是我的答案:

Sub MyCompare()
    Dim wksMaster As Worksheet
    Dim wksBases(2) As Worksheet
    Dim wksBase As Variant
    Dim intRowCountBase As Integer
    Dim intRowCountMaster As Integer
    Dim rngCell As Range
    Dim rngMasterColG As Range
    Dim intMatch As Integer

    'set up sheet vaiables
    Set wksMaster = ActiveWorkbook.Worksheets("Master")
    Set wksBases(0) = ActiveWorkbook.Worksheets("Base1")
    Set wksBases(1) = ActiveWorkbook.Worksheets("Base2")
    Set wksBases(2) = ActiveWorkbook.Worksheets("Base3")

    'get the range of the master sheet col G
    intRowCountMaster = wksMaster.UsedRange.Rows.Count
    Set rngMasterColG = wksMaster.Range(wksMaster.Cells(1, 7), wksMaster.Cells(intRowCountMaster, 7))

    'Loop through the base sheets
    For Each wksBase In wksBases
        intRowCountBase = wksBase.UsedRange.Rows.Count

        'Loop through the cells in col H of the base sheet
        For Each rngCell In wksBase.Range(wksBase.Cells(1, 8), wksBase.Cells(intRowCountBase, 8))
            If rngCell.Value <> "" Then 'only do something if there is a value in the base sheet
                On Error Resume Next
                'the match value will error if the item doesn't exist
                intMatch = Application.WorksheetFunction.Match(rngCell.Value, rngMasterColG, 0)
                If Err.Number > 0 Then ' ie there is no match
                    On Error GoTo 0

                    intRowCountMaster = intRowCountMaster + 1
                    'put the item on the master sheet
                    wksMaster.Cells(intRowCountMaster, 7).Value = rngCell.Value
                    'reset the master range
                    Set rngMasterColG = wksMaster.Range(wksMaster.Cells(1, 7), wksMaster.Cells(intRowCountMaster, 7))
                End If
            End If
        Next rngCell

    Next wksBase

End Sub