跪求大神帮写一段vba代码，vba选择两个汇总表工作簿对比，对比后新建一个工作簿储...

h十一 · 发表于 2024-1-25 21:50

跪求大神帮写一段vba代码，vba选择两个汇总表工作簿对比，对比后新建一个工作簿储存对比结果，效果详"book1"工作簿

yynrzwh · 发表于 2024-1-25 22:28

vba应该判断不了哪些行是新增的，哪些是删除的

3190496160 · 发表于 2024-1-26 09:17

1、首先得明白，判断的标准是什么？这点最关键，但是楼主没有任何说明
2、模拟的结果完全看不懂，比如，010103001001，两个文件中是完全一致的嘛，为什么会是修改行呢？？

h十一 · 发表于 2024-1-26 09:35

3190496160 发表于 2024-1-26 09:17
1、首先得明白，判断的标准是什么？这点最关键，但是楼主没有任何说明
2、模拟的结果完全看不懂，比如，01 ...

判断的标准为c，f列

3190496160 · 发表于 2024-1-26 09:37

h十一 · 发表于 2024-1-26 09:37

3190496160 发表于 2024-1-26 09:17
1、首先得明白，判断的标准是什么？这点最关键，但是楼主没有任何说明
2、模拟的结果完全看不懂，比如，01 ...

判断的标准是C,F列，修改行是因为两个表序号也做出了对比，不一样，不一样处字体标为了红色

3190496160 · 发表于 2024-1-26 15:38

Sub 数据比对()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim arr()
lj = ThisWorkbook.Path & "\"
f = Dir(lj & "宿舍-清单定额汇总表.xls*")
If f = "" Then MsgBox "找不到宿舍-清单定额汇总表": End
Set wb = Workbooks.Open(lj & f, 0)
With wb.Worksheets(1)
r = .Cells(Rows.Count, 1).End(xlUp).Row
ar = .Range("a1:g" & r)
End With
wb.Close False
ReDim arr(1 To 100000, 1 To 17)
For i = 3 To UBound(ar)
If Trim(ar(i, 1)) = "" Then ar(i, 1) = ar(i - 1, 1)
If Trim(ar(i, 1)) <> "" Then
      n = n + 1
      For j = 1 To UBound(ar, 2)
         arr(n, j + 2) = ar(i, j)
      Next j
      arr(n, 2) = "第" & i & "行"
      zd = ar(i, 3) & "|" & ar(i, 6)
      d(zd) = n
End If
Next i
Set f = Nothing
f = Dir(lj & "宿舍-清单汇总表.xls*")
If f = "" Then MsgBox "找不到宿舍-清单汇总表": End
Set wb = Workbooks.Open(lj & f, 0)
With wb.Worksheets(1)
r = .Cells(Rows.Count, 1).End(xlUp).Row
ar = .Range("a1:g" & r)
End With
wb.Close False
For i = 3 To UBound(ar)
If Trim(ar(i, 1)) = "" Then ar(i, 1) = ar(i - 1, 1)
If Trim(ar(i, 1)) <> "" Then
      zd = ar(i, 3) & "|" & ar(i, 6)
      xh = d(zd)
      If xh <> "" Then
         For j = 1 To UBound(ar, 2)
            arr(xh, j + 10) = ar(i, j)
         Next j
         arr(xh, 10) = "第" & i & "行"
      Else
         n = n + 1
         For j = 1 To UBound(ar, 2)
            arr(n, j + 10) = ar(i, j)
         Next j
         arr(n, 10) = "第" & i & "行"
         arr(n, 1) = "新增行"
      End If
End If
Next i
For i = 1 To n
If Trim(arr(i, 2)) <> "" And Trim(arr(i, 10)) = "" Then
      arr(i, 1) = "删除行"
ElseIf Trim(arr(i, 2)) = "" And Trim(arr(i, 10)) <> "" Then
      arr(i, 1) = "新增行"
ElseIf Trim(arr(i, 2)) <> "" And Trim(arr(i, 10)) <> "" Then
      zd = ""
      For j = 3 To 9
         If zd = "" Then
            zd = arr(i, j)
         Else
            zd = zd & "|" & arr(i, j)
         End If
      Next j
      zf = ""
      For j = 11 To 17
         If zf = "" Then
            zd = arr(i, j)
         Else
            zf = zf & "|" & arr(i, j)
         End If
      Next j
      If zd <> zf Then
         arr(i, 1) = "修改行"
      Else
         arr(i, 1) = ""
      End If
End If
Next i
With Sheets("对比")
.UsedRange.Offset(2).Borders.LineStyle = 0
.UsedRange.Offset(2) = Empty
.[a3].Resize(n, UBound(arr, 2)) = arr
.[a3].Resize(n, UBound(arr, 2)).Borders.LineStyle = 1
End With
Set f = Nothing
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160 · 发表于 2024-1-26 20:11

仅供参考

测试.rar (110.98 KB, 下载次数: 13)

h十一 · 发表于 2024-1-27 08:55

3190496160 发表于 2024-1-26 15:38
Sub 数据比对()
Application.ScreenUpdating = False
Dim ar As Variant

感谢大神不辞辛苦帮忙，代码很nice,俺得好好向大神学习

		自动登录	找回密码
密码			免费注册

[求助] 跪求大神帮写一段vba代码，vba选择两个汇总表工作簿对比，对比后新建一个工作簿储...

评分