|
▼杏子 さん:
以下でお試しください。
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() As Variant
Dim colB() As Variant
Dim shA As Worksheet
Dim shB As Worksheet
Dim c As Range
Dim vntTitle As Variant
vntTitle = Array("型名", "数量", "合価", "構成GC")
ReDim colA(1 To UBound(vntTitle) + 1)
ReDim colB(1 To UBound(vntTitle) + 1)
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, vntTitle) Then Exit Sub
If Not GetCol(shB, colB, vntTitle) 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, vntT As Variant) As Boolean
Dim x As Long
Dim ck As String
Dim z As Variant
x = UBound(vntT) + 1
For x = 1 To x
ck = vntT(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 sep As String
Dim d As Variant
Dim dKey As String
For Each c In sh.Range("A2", sh.Range("A" & sh.Rows.Count).End(xlUp))
dKey = ""
sep = ""
For Each d In v
dKey = dKey & sep & c.Offset(, d - 1).Value
sep = "/"
Next
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
|
|