请教

安永飞 · 发表于 2024-4-16 22:12

本帖最后由安永飞于 2024-4-17 21:25 编辑

请教老师，用VBA，在一个工作簿中，有三个工作表，格式是一样的，第三个表是空的，第一个表和第二个表，都是1至10列有数据，表1和表2工作表的行数大约有12000行，现在想把第一个表和第二表进行对比，都是从第二行开始的，发现2个表不同的行，就把不同的行，放在第三个表格中，也是从第二行依次开始放入。不知代码如何写。

taller · 发表于 2024-4-17 03:15

Sub Demo()
Dim i As Long, j As Long
Dim arrData1, arrData2, rngData As Range
Dim arrRes, iR As Long
Dim LastRow As Long, bMatch As Boolean
Dim oSht1 As Worksheet, oSht2 As Worksheet
Set oSht1 = Sheets("Sheet1")
Set oSht2 = Sheets("Sheet2")
Set rngData = oSht1.Range("A1").CurrentRegion
arrData1 = rngData.Value
Dim RowCnt As Long, ColCnt As Long
RowCnt = UBound(arrData1)
ColCnt = UBound(arrData1, 2)
Set rngData = oSht2.Range("A1").CurrentRegion
arrData2 = rngData.Value
ReDim arrRes(1 To RowCnt, 1 To ColCnt)
For i = LBound(arrData1) + 1 To RowCnt
bMatch = True
For j = LBound(arrData1, 2) To ColCnt
If Not arrData1(i, j) = arrData2(i, j) Then
bMatch = False
Exit For
End If
Next j
If Not bMatch Then
iR = iR + 1
For j = LBound(arrData1, 2) To ColCnt
arrRes(iR, j) = arrData2(i, j)
Next
End If
Next i
If iR > 0 Then
Sheets("Sheet3").Range("A2").Resize(iR, ColCnt).Value = arrRes
End If
End Sub

复制代码

LIUZHU · 发表于 2024-4-17 08:47

怎么说也得放一些脱敏后的简单的数据吧，否则不好模拟结果。

ykcbf1100 · 发表于 2024-4-17 09:30

二表比对。附件供参考。。。

3楼言之在理，既然求助总应该放点摸拟的数据上去，你就一个表头，写代码时就无法调试。

ykcbf1100 · 发表于 2024-4-17 09:31

参与一下。。。

Sub ykcbf() '//2024.4.17
Application.ScreenUpdating = False
Dim arr, brr
arr = Sheet1.Range("a1").CurrentRegion
brr = Sheet2.Range("a1").CurrentRegion
ReDim zrr(1 To UBound(arr), 1 To 10)
For i = 2 To UBound(arr)
st1 = "": st2 = ""
For x = 1 To 10
st1 = st1 & arr(i, x)
st2 = st2 & brr(i, x)
Next
If st1 <> st2 Then
m = m + 1
For x = 1 To 10
zrr(m, x) = brr(i, x)
Next
End If
Next
With Sheet3
.UsedRange.Offset(1) = Empty
.[a2].Resize(m, 10) = zrr
End With
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub

复制代码

安永飞 · 发表于 2024-4-17 09:37

本帖最后由安永飞于 2024-4-17 21:32 编辑

因为，数据敏感，所以没有放入，抱歉。感谢各位老师的指导。我的数据表一和表二，大体相同，一共10600行左右。以下代码不知错那了

Sub CompareSheetsAndCopyDifferences()
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim lastRow1 As Long, lastRow2 As Long, row3 As Long
Dim i As Long, j As Long, isDifferent As Boolean

' 设置工作表对象
Set ws1 = ThisWorkbook.Sheets("Sheet1") ' 第一个工作表
Set ws2 = ThisWorkbook.Sheets("Sheet2") ' 第二个工作表
Set ws3 = ThisWorkbook.Sheets("Sheet3") ' 第三个工作表（空的）

' 获取第一个和第二个工作表的最后一行
lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

' 初始化第三个工作表的当前行号
row3 = 2

' 遍历第一个工作表的每一行
For i = 2 To lastRow1
      isDifferent = False ' 假设当前行是相同的

      ' 遍历第二个工作表的每一行以查找匹配项
      For j = 2 To lastRow2
         ' 检查是否整行数据相同
         If Application.WorksheetFunction.CountIf(ws1.Rows(i), ws2.Rows(j)) = ws1.Cells(i, 1).End(xlToRight).Column Then
            ' 如果找到匹配项，则退出内层循环
            Exit For
         Else
            ' 如果不同，则标记为不同
            isDifferent = True
         End If
      Next j

      ' 如果当前行在两个表中不同，则将其复制到第三个表中
      If isDifferent Then
         ws1.Rows(i).Copy Destination:=ws3.Rows(row3)
         row3 = row3 + 1 ' 更新第三个工作表的当前行号
      End If
Next i

' 提示任务完成
MsgBox "Comparison complete. Differences copied to Sheet3."
End Sub

tanglf188 · 发表于 2024-4-17 10:20

自己写的数据比对工具，看看有需要吧，有的话我传附件

skiss · 发表于 2024-4-17 11:19

tanglf188 发表于 2024-4-17 10:20
自己写的数据比对工具，看看有需要吧，有的话我传附件

老师我想要一个，能分享一个吗

2324104030 · 发表于 2024-4-17 11:53

tanglf188 发表于 2024-4-17 10:20
自己写的数据比对工具，看看有需要吧，有的话我传附件

大佬。想一个

tanglf188 · 发表于 2024-4-17 13:38

skiss 发表于 2024-4-17 11:19
老师我想要一个，能分享一个吗

第一行为标题，第二行开始为数据，如果有多行标题自己调整一下SQL语句的数据源。

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

[求助] 请教

评分

评分

评分

评分