|
|
Sub 数据比对()
Dim ar As Variant, br As Variant
Dim d As Object, dc As Object
Dim rn As Range, rng As Range
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("纸质火车票扫描版")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "纸质火车票扫描版为空！": End
ar = .Range("a1:i" & r)
.Range("a1:i" & r).Interior.ColorIndex = 0
End With
For i = 2 To UBound(ar)
If ar(i, 1) <> "" Then
zf = ""
ar(i, 5) = Format(ar(i, 5), "h:mm")
For j = 1 To UBound(ar, 2)
If zf = "" Then
zf = ar(i, j)
Else
zf = zf & "|" & ar(i, j)
End If
Next j
d(zf) = i
End If
Next i
With Sheets("原始版")
rs = .Cells(Rows.Count, 1).End(xlUp).Row
If rs < 2 Then MsgBox "原始版为空！": End
br = .Range("a1:i" & rs)
.Range("a1:i" & rs).Interior.ColorIndex = 0
For i = 2 To UBound(br)
If br(i, 1) <> "" Then
zd = ""
br(i, 4) = CDate(br(i, 4))
br(i, 5) = Format(br(i, 5), "h:mm")
For j = 1 To UBound(br, 2)
If zd = "" Then
zd = br(i, j)
Else
zd = zd & "|" & br(i, j)
End If
Next j
If Not d.exists(zd) Then
If rn Is Nothing Then
Set rn = .Cells(i, 1).Resize(1, 9)
Else
Set rn = Union(rn, .Cells(i, 1).Resize(1, 9))
End If
End If
dc(zd) = i
End If
Next i
If Not rn Is Nothing Then rn.Interior.ColorIndex = 4
Set rn = Nothing
End With
For i = 2 To UBound(ar)
If ar(i, 1) <> "" Then
zf = ""
For j = 1 To UBound(ar, 2)
If zf = "" Then
zf = ar(i, j)
Else
zf = zf & "|" & ar(i, j)
End If
Next j
If Not dc.exists(zf) Then
If rn Is Nothing Then
Set rn = Sheets("纸质火车票扫描版").Cells(i, 1).Resize(1, 9)
Else
Set rn = Union(rn, Sheets("纸质火车票扫描版").Cells(i, 1).Resize(1, 9))
End If
End If
End If
Next i
If Not rn Is Nothing Then rn.Interior.ColorIndex = 4
Set rn = Nothing
MsgBox "ok!"
End Sub
|
|
楼主: 黄培
沪公网安备 31011702000001号 沪ICP备11019229号-2
楼主
发表于 2024-7-16 11:47
