ＶＢＡでやってみました。
エクセルのウィンドウ左下にあるシートタブの、左から１番目と２番目のシートを比較します。

各々のシートのＡ列に大字、Ｂ列に小字、Ｃ列に地番を置いてください。
セルＡ１から下に、空白のセルがでるまで検索、比較します。
１）はSub両方()で、
２）３）はSub片方()でどうぞ。

Sub 両方()
Dim c As Range, c2 As Range, c3 As Range, p As Byte
Dim w As Worksheet, f As Long

Set c = Worksheets(1).Range("A1:C1")
Set c2 = Worksheets(2).Range("A1:C1")
Set w = Worksheets.Add(, Worksheets(2))
w.Range("A1").Value = Worksheets(1).Name & _
" と、 " & Worksheets(2).Name & " 両方にある"
Set c3 = w.Range("A2:C2")

Do
Do While c2.Columns(1).Value <> ""
For p = 1 To 3
If c.Columns(p).Value <> c2.Columns(p).Value Then Exit For
If p = 3 Then
c3.Offset(f, 0).Value = c.Value
f = f + 1
Exit Do
End If
Next p
Set c2 = c2.Offset(1, 0)
Loop
Set c2 = Worksheets(2).Range("A1:C1")
Set c = c.Offset(1, 0)
Loop Until c.Columns(1).Value = ""
End Sub


Sub 片方()
Dim c As Range, c2 As Range, c3 As Range, p As Byte
Dim w As Worksheet, f As Long, i As Byte, n As Byte, k As Byte
Set w = Worksheets.Add(, Worksheets(2))
w.Range("A1").Value = Worksheets(1).Name & " だけにある"
Set c3 = w.Range("A2:C2")

For n = 1 To 2
If n = 1 Then
k = 2
Else
k = 1
f = 0
w.Range("E1").Value = Worksheets(n).Name & " だけにある"
Set c3 = w.Range("E2:G2")
End If

Set c = Worksheets(n).Range("A1:C1")
Set c2 = Worksheets(k).Range("A1:C1")

Do
i = 0
Do
For p = 1 To 3
If c.Columns(p).Value <> c2.Columns(p).Value Then Exit For
If p = 3 Then
i = 1
End If
Next p
Set c2 = c2.Offset(1, 0)
Loop Until c2.Columns(1).Value = ""
If i = 0 Then
c3.Offset(f, 0).Value = c.Value
f = f + 1
End If
Set c2 = Worksheets(k).Range("A1:C1")
Set c = c.Offset(1, 0)
Loop Until c.Columns(1).Value = ""
Next n
End Sub

投稿日時 - 2003-09-23 03:18:33