两个Excel文件的VBA比较

时间:2018-12-04 20:47:03

标签: excel vba excel-vba

我正在尝试根据特定列使用vba宏比较两个Excel工作表(文件之间会有所不同)。如果列的内容相同,那么我正在尝试将目标文件的其余列内容复制到源文件。我已经编写了相同的代码,但是在计算count的值后,我不明白为什么它不在最后的IF语句中。

Sub Compare_sheet()

Dim vnt As Variant
Dim myValue As Variant
Dim myString As String
Dim F1_Workbook As Workbook
Dim F2_Workbook As Workbook
Dim k As Variant
Dim identifier() As Integer
Dim identifier2() As Integer
Dim Other() As Integer
Dim Other2() As Integer
Dim copy_cell As Variant
Dim C() As Variant
Dim D() As Variant

Count = 0

MsgBox " Please select the source file "
vnt_Source = Application.GetOpenFilename("Excel Files (*.xlsx; *.xls; 
*.xlsm),*.xlsx;*.xls;*.xlsm", 1, "Please select the file to open")

MsgBox " Please select the destination file"
vnt_destination = Application.GetOpenFilename("Excel Files (*.xlsx; *.xls; 
*.xlsm),*.xlsx;*.xls;*.xlsm", 1, "Please select the file to open")

Set F1_Workbook = Workbooks.Open(vnt_Source)
Set F2_Workbook = Workbooks.Open(vnt_destination)

lastRow1 = F1_Workbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

lastrow2 = F2_Workbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

input1 = InputBox("Input the number of identifiers you want")
ReDim identifier(1 To input1) As Integer
ReDim identifier2(1 To input1) As Integer
ReDim C(1 To input1) As Variant
ReDim D(1 To input1) As Variant

For k = 1 To input1
    identifier(k) = InputBox("Enter the identifier column number in source file")
    identifier2(k) = InputBox("Enter the same identifier column number in destination file")
Next k
y = input1

For i = 1 To lastRow1
    For j = 1 To lastrow2
        For x = 1 To input1
            C(x) = F1_Workbook.Sheets(1).Cells(i, identifier(x)).Value
            D(x) = F2_Workbook.Sheets(1).Cells(j, identifier2(x)).Value
            MsgBox "c d" & C(x) & D(x)
        Next x

        For b = 1 To y
            If C(b) = D(b) Then
                Count = Count + 1
            End If
        Next b

        MsgBox "count" & Count

        If Count = input1 Then
            copycell = InputBox("enter the number of cells you want to copy")
            ReDim Other(1 To copy_cell) As Integer
            ReDim Other2(1 To copy_cell) As Integer

            For copynum = 1 To copy_cell
                Other(copynum) = InputBox("enter the column number of the cell to be copied in the source file")
                Other2(copynum) = InputBox("enter the column number of the same cell to be copied in the destination file")
            Next copynum

            For a = 1 To copy_cell
                myValue = F1_Workbook.Sheets(1).Cells(i, Other(a)).Value
                F2_Workbook.Sheets(1).Cells(j, Other2(a)).Value = myValue
            Next a

        End If

    Next j

Next i

MsgBox "DONE!!!"

End Sub

1 个答案:

答案 0 :(得分:0)

您永远不会在循环内将Count重置为零,因此该值只会不断增加

'...
Count = 0
For b = 1 To y
'...