VBA сравнение двух файлов Excel - PullRequest
0 голосов
/ 04 декабря 2018

Я пытаюсь сравнить два листа Excel, используя макрос VBA на основе конкретных столбцов (будет варьироваться от файла к файлу).Если содержимое столбцов одинаковое, то я пытаюсь скопировать содержимое оставшегося столбца файла назначения в исходный файл.Я написал код для того же самого, но я не могу понять, почему он не входит в последний оператор IF после вычисления значения count.

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 голосов
/ 05 декабря 2018

Вы никогда не сбросите Count в ноль внутри цикла, поэтому значение просто увеличивается

'...
Count = 0
For b = 1 To y
'...
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...