| |
▼杏子 さん：
ということで、とりあえず。
でも、杏子さんの意図は、ほんとにそうなのかなぁ？？ と。
Sub Sample2()
Dim dicA As Object
Dim dicB As Object
Dim dicAonly As Object
Dim dicBonly As Object
Dim dicComp As Object
Dim d As Variant
Dim colA(1 To 5) As Variant
Dim colB(1 To 5) As Variant
Dim shA As Worksheet
Dim shB As Worksheet
Dim c As Range
Set dicA = CreateObject("Scripting.Dictionary")
Set dicB = CreateObject("Scripting.Dictionary")
Set dicAonly = CreateObject("Scripting.Dictionary")
Set dicBonly = CreateObject("Scripting.Dictionary")
Set dicComp = CreateObject("Scripting.Dictionary")
Set shA = Sheets("Sheet1")
Set shB = Sheets("Sheet2")
If Not GetCol(shA, colA) Then Exit Sub
If Not GetCol(shB, colB) Then Exit Sub
CreateDic shA, dicA, colA
CreateDic shB, dicB, colB
OnlyCheck dicA, dicB, dicAonly
OnlyCheck dicB, dicA, dicBonly
If dicAonly.Count = 0 Then
MsgBox "資料(A)にある内容はすべて資料(B)と同じでした"
Else
MsgBox "資料(A)のうち、以下が資料(B)にありません" & vbLf & Join(dicAonly.keys, vbLf)
End If
If dicBonly.Count = 0 Then
MsgBox "資料(B)にある内容はすべて資料(A)と同じでした"
Else
MsgBox "資料(B)のうち、以下が資料(A)にありません" & vbLf & Join(dicBonly.keys, vbLf)
End If
End Sub
Private Function GetCol(sh As Worksheet, v As Variant) As Boolean
Dim x As Long
Dim ck As String
Dim z As Variant
For x = 1 To 5
ck = Array("型名", "数量", "金額", "納期", "納地")(x - 1)
z = Application.Match(ck, sh.Rows(1), 0)
If IsError(z) Then
MsgBox sh.Name & "のタイトル行に" & ck & "がないので処理を終了します"
Exit Function
End If
v(x) = z
Next
GetCol = True
End Function
Private Sub CreateDic(sh As Worksheet, dic As Object, v As Variant)
Dim c As Range
Dim dKey As String
For Each c In sh.Range("A2", sh.Range("A" & sh.Rows.Count).End(xlUp))
dKey = c.Offset(, v(1) - 1).Value & "/" & _
c.Offset(, v(2) - 1).Value & "/" & _
c.Offset(, v(3) - 1).Value & "/" & _
c.Offset(, v(4) - 1).Value & "/" & _
c.Offset(, v(5) - 1).Value
dic(dKey) = True
Next
End Sub
Private Sub OnlyCheck(dic1 As Object, dic2 As Object, dicOnly As Object)
Dim d As Variant
For Each d In dic1
If Not dic2.exists(d) Then dicOnly(d) = True
Next
End Sub
|
|
UO3
- 12/8/19(日) 17:34 -
