比较两个独立的文档VBA



我要做的是在工作簿a中创建一个宏打开工作簿B和C,然后遍历工作簿B和C的a列当两个值相等时它从工作簿C中获取值并将其粘贴到工作簿a的a列。

我已经写了下面的代码,但是如果你认为用另一种方式更容易,请随意写你自己的代码。谢谢你,请帮助我:)

Sub ReportCompareAlta()
'
' ReportCompareAlta Macro
' Adds instances where column D is "ALTA"
    Dim varSheetA As Variant
    Dim varSheetB As Variant
    Dim varSheetC As Variant
    Dim StrValue As Variant
    Dim strRangeToCheck As String
    Dim iRow As Long
    Dim iCol As Long
    Dim WbkA As Workbook
    Dim WbkB As Workbook
    Dim WbkC As Workbook
    Dim counter As Long
    Set WbkA = Workbooks.Open(Filename:="G:ReportingAH_MISSE_FEB2013.xls")
    Set WbkB = Workbooks.Open(Filename:="G:ReportingAH_MISSE_MAR2013.xls")
    Set WbkC = Workbooks.Open(Filename:="G:ReportingReportCompare.xls")
    Set varSheetA = WbkA.Worksheets("LocalesMallContratos")
    Set varSheetB = WbkB.Worksheets("LocalesMallContratos")
    Set varSheetC = WbkC.Worksheets("Sheet1")

    strRangeToCheck = "A1:IV65536"
    Debug.Print Now
    varSheetA = WbkC.Worksheets("Sheet2").Range(strRangeToCheck) 'may be confusing code here
    varSheetB = WbkC.Worksheets("Sheet3").Range(strRangeToCheck) 'may be confusing code here
    Debug.Print Now
    counter = 0
    For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)        
            If varSheetB(iRow, "B") = varSheetA(iRow, "B") & varSheetB(iRow, "B") <> "GERENCIA" & varSheetB(iRow, "B").Value <> "" & varSheetB(iRow, "D") = "ALTA" Then
                StrValue = ""
                varSheetB.Range("iRow:B").Select 
                Selection = StrValue
                ActiveSheet = varSheetC
                Range("A1").Select
                Selection.Offset(counter, 0).Value = StrValue
                counter = counter - 1
            Else
                MsgBox ("Done")
            End If         
    Next iRow
End Sub

您需要在代码中使用'AND'而不是'&'符号。使用'&'只是将值连接起来,这将导致if语句失败。

我看到了Mat Richardson指出的一些明显的错误,使用&不是等同于AND操作符的简写,它是一个连接器,当你说:

时,这可能不是你想要的:

If varSheetB(iRow, "B") = varSheetA(iRow, "B") & varSheetB(iRow, "B") <> "GERENCIA" & varSheetB(iRow, "B").Value <> "" & varSheetB(iRow, "D") = "ALTA" Then

这给我带来了另一个错误:

varSheetB(以及A和C)是变量/数组变量。因为不能使用非数字索引,所以不能通过iRow, "B"对它们进行索引。也许你指的是(iRow, 2)。

在一个相关的注意事项:varSheetB.Range("iRow:B").Select这也会失败,因为你不能.Select一个变体。这是而不是一个Range变量。此外,iRow:B对于Variant数组或Range变量的都是不正确的。而且,此时varSheetB不再是Worksheet对象变量。

这可能给我带来了最大的错误:您正在使用变量varSheetA, varSheetBvarSheetC来表示(在此代码中的不同时间)Worksheet Object和变量数组的值。这是令人困惑的,并且可能导致您出现上述错误。一个变量不能同时是这两件事,所以你需要把你的变量当作变量,当它们是变量时,就像工作表一样,当它们是工作表时,或者更好的是:为工作表使用工作表变量,为数组使用变量,不要为多个目的使用相同的变量。

Sub ReportCompareAlta()
'
' ReportCompareAlta Macro
Dim varSheetA As Worksheet
Dim varSheetB As Worksheet
Dim varSheetC As Worksheet
Dim RangeToCheck As Range
Dim cl as Range
Dim iRow As Long
Dim iCol As Long
Dim WbkA As Workbook
Dim WbkB As Workbook
Dim WbkC As Workbook
Dim counter As Long
Set WbkA = Workbooks.Open(Filename:="G:ReportingAH_MISSE_FEB2013.xls")
Set WbkB = Workbooks.Open(Filename:="G:ReportingAH_MISSE_MAR2013.xls")
Set WbkC = Workbooks.Open(Filename:="G:ReportingReportCompare.xls")
Set varSheetA = WbkA.Worksheets("LocalesMallContratos")
Set varSheetB = WbkB.Worksheets("LocalesMallContratos")
Set varSheetC = WbkC.Worksheets("Sheet1")

Set RangeToCheck = varSheetA.Range("A1:A65536") '## I change this because you only indicate you want to compare column A ##'
counter = 0
'## just loop over the cells in the range. ##'
'## This is not the most efficient, but it is the easiest ##'
For each cl in RangeToCheck  
    '## Do your comparison here, e.g: ##'
    '## Ignore cells where .Offset(0,3).Value = "ALTA" Or cl.Value = "" ##'
    If not cl.Offset(0,3).Value = "ALTA" Or Not cl.Value = vbNullString Then
        If Not cl.Value = varSheetB.Range(cl.Address).Value Then
           '## The values are not equal, so do something:
                varSheetC.Range(cl.Address) = "not equal"
           counter = counter+1
        Else:
           '## The values are equal, so do something else:
            varSheetC.Range(cl.Address) = "equal"
        End If
   End If
Next

MsgBox "Done! There were " & counter & " mismatch values", vbInformation
End Sub

最新更新