Sub 比較と記載1()
’Dictionaryにてremoveメソッド利用(ないものを削除パターン)
Dim ws As Worksheet
Dim lastRow1, lastRow2 As Long
Dim aRange As Range, cRange As Range
Dim aValue As Variant, cValue As Variant
Dim compareColumnA As Range, compareColumnC As Range
Dim resultDictA As Object, resultDictC As Object
Dim i As Long
' 対象のシートを設定
Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を変更する必要があるかもしれません
' 比較する列を選択
On Error Resume Next
Set compareColumnA = Application.InputBox("比較する列Aを選択してください", Type:=8)
On Error GoTo 0
If compareColumnA Is Nothing Then Exit Sub ' ユーザーがキャンセルした場合、処理を終了
On Error Resume Next
Set compareColumnC = Application.InputBox("比較する列Cを選択してください", Type:=8)
On Error GoTo 0
If compareColumnC Is Nothing Then Exit Sub ' ユーザーがキャンセルした場合、処理を終了
' 最終行を取得
lastRow1 = ws.Cells(ws.Rows.Count, compareColumnA.Column).End(xlUp).Row
lastRow2 = ws.Cells(ws.Rows.Count, compareColumnC.Column).End(xlUp).Row
' 比較対象の列を設定
Set aRange = ws.Range(compareColumnA.Offset(1), compareColumnA.Offset(lastRow1 - 1))
Set cRange = ws.Range(compareColumnC.Offset(1), compareColumnC.Offset(lastRow2 - 1))
' 空のディクショナリを作成
Set resultDictA = CreateObject("Scripting.Dictionary")
Set resultDictC = CreateObject("Scripting.Dictionary")
' a列の値をディクショナリに追加
For Each aValue In aRange
resultDictA(aValue) = aValue
Next aValue
' c列の値をディクショナリに追加
For Each cValue In cRange
resultDictC(cValue) = cValue
Next cValue
' 重複するキーを削除
For Each aValue In resultDictA.Keys
If resultDictC.Exists(aValue) Then
resultDictA.Remove aValue
resultDictC.Remove aValue
End If
Next aValue
' 結果を出力
Dim resultSheet As Worksheet
Set resultSheet = ThisWorkbook.Sheets.Add ' 新しいシートを作成して結果を記録
' ヘッダーを設定
resultSheet.Cells(1, 1).Value = "列Aにのみ存在"
resultSheet.Cells(1, 2).Value = "列Cにのみ存在"
' 結果を出力
Dim rowIndex As Long
rowIndex = 2 ' ヘッダーの下から始める
For Each aValue In resultDictA.Keys
resultSheet.Cells(rowIndex, 1).Value = aValue
rowIndex = rowIndex + 1
Next aValue
rowIndex = 2 ' ヘッダーの下から始める
For Each cValue In resultDictC.Keys
resultSheet.Cells(rowIndex, 2).Value = cValue
rowIndex = rowIndex + 1
Next cValue
End Sub
Sub 比較と記載2()
'’Dictionaryにて、比較結果パターン
Dim ws As Worksheet
Dim lastRow1, lastRow2 As Long
Dim aRange As Range, cRange As Range
Dim aValue As Variant, cValue As Variant
Dim i As Long
Dim compareColumnA As Range, compareColumnC As Range
Dim resultDictA As Object, resultDictC As Object
' 対象のシートを設定
Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を変更する必要があるかもしれません
' 比較する列を選択
On Error Resume Next
Set compareColumnA = Application.InputBox("比較する列Aを選択してください", Type:=8)
On Error GoTo 0
If compareColumnA Is Nothing Then Exit Sub ' ユーザーがキャンセルした場合、処理を終了
On Error Resume Next
Set compareColumnC = Application.InputBox("比較する列Cを選択してください", Type:=8)
On Error GoTo 0
If compareColumnC Is Nothing Then Exit Sub ' ユーザーがキャンセルした場合、処理を終了
' 最終行を取得
lastRow1 = ws.Cells(ws.Rows.Count, compareColumnA.Column).End(xlUp).Row
lastRow2 = ws.Cells(ws.Rows.Count, compareColumnC.Column).End(xlUp).Row
' 比較対象の列を設定
Set aRange = ws.Range(compareColumnA.Offset(1), compareColumnA.Offset(lastRow1 - 1))
Set cRange = ws.Range(compareColumnC.Offset(1), compareColumnC.Offset(lastRow2 - 1))
' 空のディクショナリを作成
Set resultDictA = CreateObject("Scripting.Dictionary")
Set resultDictC = CreateObject("Scripting.Dictionary")
' a列にしかない値をディクショナリに追加
For Each aValue In aRange
If IsError(Application.Match(aValue, cRange, 0)) Then
If Not resultDictA.Exists(aValue) Then
resultDictA.Add aValue, aValue
End If
End If
Next aValue
' c列にしかない値をディクショナリに追加
For Each cValue In cRange
If IsError(Application.Match(cValue, aRange, 0)) Then
If Not resultDictC.Exists(cValue) Then
resultDictC.Add cValue, cValue
End If
End If
Next cValue
' 結果を出力
Dim resultSheet As Worksheet
Set resultSheet = ThisWorkbook.Sheets.Add ' 新しいシートを作成して結果を記録
' ヘッダーを設定
resultSheet.Cells(1, 1).Value = "列Aにのみ存在"
resultSheet.Cells(1, 2).Value = "列Cにのみ存在"
' 結果を出力
Dim rowIndex As Long
rowIndex = 2 ' ヘッダーの下から始める
For Each aValue In resultDictA.Keys
resultSheet.Cells(rowIndex, 1).Value = aValue
rowIndex = rowIndex + 1
Next aValue
rowIndex = 2 ' ヘッダーの下から始める
For Each cValue In resultDictC.Keys
resultSheet.Cells(rowIndex, 2).Value = cValue
rowIndex = rowIndex + 1
Next cValue
End Sub
