以下是我正在努力实现的一些背景知识。
我有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
答案 0 :(得分：0)
考虑以下几点：
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