エクセルについて教えてください。

マクロの例ですが、せっかく作ったのですがコメントさせてください。

適当なEXCEL ファイルで ALT+F11、挿入⇒標準モジュールで下記を貼り付け、
先頭の部分でシート名列名を修正のうえマクロの実行ください。

Option Explicit

'比較元Aのシート名と名前の列
Const sheetNameA = "Sheet1"
Const nameColA = "A"

'比較元Bのシート名と名前の列
Const sheetNameB = "Sheet2"
Const nameColB = "A"

'---------------------------------------------------
'-- 一つのシートで結果を表示
'-- A、D列に比較データ：B、E列にそれぞれのマッチする行数を表示
'-- 同じ名前がある場合は：セルの色を緑
'-- 似ている名前（部分一致）がある場合は：セルの色を黄
'-- 同じ名前がある複数場合は、カンマで区切って表示：セルの色を赤
'---------------------------------------------------
Sub dongwu()
　　Dim wsA As Worksheet
　　Dim wsB As Worksheet
　　Dim wsT As Worksheet
　　
　　Set wsA = Worksheets(sheetNameA)
　　Set wsB = Worksheets(sheetNameB)
　　Set wsT = Worksheets.Add(before:=Worksheets(1))
　　
　　wsA.Columns(nameColA).Copy Destination:=wsT.Columns("A")
　　wsB.Columns(nameColB).Copy Destination:=wsT.Columns("D")
　　
　　Dim lastRow As Long
　　lastRow = wsT.Range("A" & Rows.Count).End(xlUp).Row
　　Dim i As Long
　　For i = 1 To lastRow
　　　　wsT.Cells(i, "A").Value = modName(wsT.Cells(i, "A").Value)
　　Next
　　
　　lastRow = wsT.Range("D" & Rows.Count).End(xlUp).Row
　　For i = 1 To lastRow
　　　　wsT.Cells(i, "D").Value = modName(wsT.Cells(i, "D").Value)
　　Next
　　
　　comp wsT, "A", "D"
　　comp wsT, "D", "A"
End Sub

Sub comp(wsT As Worksheet, srcCol As String, dstCol As String)
　　Dim lastRow As Long
　　Dim i As Long
　　
　　lastRow = wsT.Range(srcCol & Rows.Count).End(xlUp).Row
　　Dim ret1 As Range, retN As Range
　　For i = 1 To lastRow
'※完全一致にしたい場合は、 lookat:=xlWhole
'※部分一致にしたい場合は、 lookat:=xlPart
　　　　Set ret1 = wsT.Columns(dstCol).Find(what:=wsT.Cells(i, srcCol).Value, lookat:=xlPart)
　　　　If Not ret1 Is Nothing Then
　　　　　　wsT.Cells(i, srcCol).Offset(0, 1).Value = ret1.Row
　　　　　　If ret1.Value <> wsT.Cells(i, srcCol).Value Then
　　　　　　　　wsT.Cells(i, srcCol).Interior.ColorIndex = 36
　　　　　　Else
　　　　　　　　wsT.Cells(i, srcCol).Interior.ColorIndex = 35
　　　　　　End If
　　　　　　Set retN = wsT.Columns(dstCol).FindNext(ret1)
　　　　　　Do While retN.Address <> ret1.Address
　　　　　　　　Cells(i, srcCol).Offset(0, 1).Value = wsT.Cells(i, srcCol).Offset(0, 1).Value & "," & retN.Row
　　　　　　　　wsT.Cells(i, srcCol).Interior.ColorIndex = 38
　　　　　　　　Set retN = wsT.Columns(dstCol).FindNext(retN)
　　　　　　Loop
　　　　End If
　　Next
End Sub

Function modName(srcName As String) As String
　　Dim bpos As Integer
　　
　　srcName = Replace(srcName, "（", "(")　' 半角へ置換
　　bpos = InStr(srcName, "(")
　　If bpos > 0 Then
　　　　srcName = Left(srcName, bpos - 1)
　　End If
　　
　　srcName = Trim(srcName)
　　srcName = Replace(srcName, " ", "")　' 半角スペースの置換
　　modName = Replace(srcName, "　", "")　' 全角スペースの置換
End Function

MOOKさん

ご丁寧に有難うございます。
使わせていただきます。