Question

以下是我正在努力实现的一些背景知识。

我有2个excel文件（旧版和新版），其中包含大约10-15张图纸，每张图纸包含许多行数据，每张图纸的总列数不同。

我查看了旧文件，并为每张图表中最后一列数据中的所有行添加了注释。

现在每当我收到一个新文件时，我需要首先比较工作表名称，如果匹配则将该工作表的行与旧工作表进行比较，如果找到则将旧工作表的最后一列中的注释复制到新工作表。

简而言之，这是一种和解表。我已经尝试了以下代码，但没有得到如何循环以进行工作簿和行的比较。

Sub recon()

Dim wb As Workbook
Dim sht As Worksheet
Dim sht2 As Worksheet
Dim rnge As Range

Set wb = Workbooks("OldWB")

For Each sht In wb.Sheets

    On Error Resume Next

    Set sht2 = ActiveWorkbook.Sheets(sht.Name)

    On Error GoTo 0

    If Not sht2 Is Nothing Then

        For Each rnge In sht.UsedRange

            If sht2.Range(rnge.Address).Value = "" And rnge.Value <> "" Then 
             Copy sht2.Range(rnge.Address).Offset(0,1).Value = rnge.Value                                       
            End If
                    Next rnge

        Set sht2 = Nothing

    End If
    Next sht
    Set wb = Nothing

End Sub

Answer 1

考虑以下几点：
1。如果工作簿中的工作表的顺序相同，则此代码将为您提供所需的结果 2. 我计算每一行的列数，假设列数可能在每张表中逐行变化。如果不是这种情况，您可以在lastColumnCurr循环开头为lastColumnOld和For Each指定值。

Sub recon()
    Dim wbOld As Workbook
    Dim wsOld As Worksheet, wsCurr As Worksheet
    Dim lastRowCurr As Long, lastRowOld As Long, lastColumnCurr As Long, lastColumnOld As Long
    Dim i As Long, j As Long
    Dim flag As Boolean

    Set wbOld = Workbooks("old_test")

    For Each wsOld In wbOld.Sheets
        lastRowOld = wsOld.Cells(Rows.Count, "A").End(xlUp).Row

        On Error Resume Next

        Set wsCurr = ActiveWorkbook.Sheets(wsOld.Name)
        On Error GoTo 0

        If Not wsCurr Is Nothing Then
            'get number of rows in current sheet
            lastRowCurr = wsCurr.Cells(Rows.Count, "A").End(xlUp).Row
            'loop through all the rows
            For i = 1 To lastRowCurr
                'get number of columns in old and current sheets
                lastColumnOld = wsOld.Cells(i, Columns.Count).End(xlToLeft).Column
                lastColumnCurr = wsCurr.Cells(i, Columns.Count).End(xlToLeft).Column
                'maintain a boolean to check whether all the values in a row are same or not
                flag = True
                'now loop through all the columns in a row
                'here if the row in current sheet is same as the old sheet then there will be one column...
                '...less in current sheetin compared to old sheet because of your comment column at the end...
                '...hence lastColumnOld - 1
                If lastColumnCurr = lastColumnOld - 1 Then
                    For j = 1 To lastColumnCurr
                        'now all the cells in a row in both sheets
                        If wsOld.Cells(i, j).Value <> wsCurr.Cells(i, j).Value Then
                            'if cell is not same, change boolean to false
                            flag = False
                            Exit For
                        End If
                    Next j
                    'if boolean is false then there is difference in rows so do not add comment at the end
                    If flag = True Then
                        wsCurr.Cells(i, j).Value = wsOld.Cells(i, j).Value
                    End If
                End If
            Next i
            Set wsCurr = Nothing
        End If
    Next wsOld
    Set wb = Nothing
End Sub

编辑＃1
的 _________________________________________________________________________________

以下代码会将活动工作表的每一行与旧工作簿中工作表的所有行匹配。

Sub CompareRows_Mrig() Dim wbOld As Workbook Dim wsOld As Worksheet, wsCurr As Worksheet Dim lastRowCurr As Long, lastRowOld As Long, lastColumnCurr As Long, lastColumnOld As Long Dim flag As Boolean Set wbOld = Workbooks("old_test") For Each wsOld In wbOld.Sheets lastRowOld = wsOld.Cells(Rows.Count, "A").End(xlUp).Row On Error Resume Next Set wsCurr = ActiveWorkbook.Sheets(wsOld.Name) On Error GoTo 0 If Not wsCurr Is Nothing Then lastRowCurr = wsCurr.Cells(Rows.Count, "A").End(xlUp).Row Dim c As Long Dim rIdx As Long, cIdx As Long For rIdx = 1 To lastRowCurr lastColumnCurr = wsCurr.Cells(rIdx, Columns.Count).End(xlToLeft).Column c = 0 For rIdx2 = 1 To lastRowOld lastColumnOld = wsOld.Cells(rIdx2, Columns.Count).End(xlToLeft).Column - 1 If lastColumnCurr = lastColumnOld Then flag = True For cIdx = 1 To lastColumnCurr If wsCurr.Cells(rIdx, cIdx).Value <> wsOld.Cells(rIdx2, cIdx).Value Then flag = False Exit For End If Next c = c + 1 Debug.Print c If flag = True Then wsCurr.Cells(rIdx, cIdx).Value = wsOld.Cells(rIdx2, cIdx).Value End If End If Next Next End If Next wsOld Set wb = Nothing End Sub

编辑＃2
的 _________________________________________________________________________________

要加速代码，请在sub：
中添加以下行
Sub CompareRows_Mrig() Application.Calculation = xlCalculationManual Application.ScreenUpdating = False '***************************** 'Put Code Here '***************************** Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

如果其余数据匹配，则比较两个工作簿并复制最后一列

1 个答案: