エクセルVBA 重複を表示したい

エクセルVBA 重複を表示したい

Ａ列で重複すると警告するコードを以下のように作成しました。
これを修正してＡ列で重複して、なおかつＢ列でも重複した場合警告するコードにしたいのです。
添付した図では「同姓同名あり、確認してください、鈴木一郎、山口」と表示したいのです。
ご教授よろしくお願いします。

Sub test()
Dim myRange As Range
Dim 同一flag As Boolean
Dim MsgStr As String

For Each myRange In Range("A2:A10")
If WorksheetFunction.CountIf(Range("A2:A10"), myRange) > 1 Then
If 同一flag = False Then 同一flag = True
If InStr(1, MsgStr, myRange) = 0 Then
MsgStr = MsgStr & myRange & vbCrLf
End If
End If
Next

If 同一flag = True Then
MsgBox "同姓同名あり" & Chr(13) & _
"確認してください" & Chr(13) & _
vbCrLf & MsgStr
Else
End If
End Sub

No.1 回答者： keithin 回答日時： 2010/04/25 10:44

アイデア次第で，いくらでもやりようはあります。

例：
Sub macro1()
　Dim a, b(), c
　Dim res As String

　a = Range("A1:B" & Range("A65536").End(xlUp).Row)
　ReDim b(1 To UBound(a))

　For c = 1 To UBound(a)
　　b(c) = a(c, 1) & "、" & a(c, 2)
　　If c <> Application.Match(b(c), b, 0) Then
　　　res = res & vbCr & b(c)
　　End If
　Next c
　
　If res <> "" Then
　　MsgBox "found " & res
　End If
End Sub

この回答へのお礼

ご回答ありがとうございます。
ご教授いただいたコードだとＢ列が空白でも表示されてしまいます。
Ａ列=Ｂ列が重複した場合にのみ表示したいのです。
よろしくお願いします。

お礼日時：2010/04/25 16:03

No.2 ベストアンサー 回答者： kmetu 回答日時： 2010/04/25 15:41

たとえば　C列に　=A2&B2　として下にフィル

コードのA2:A10をC2:C10とかに変更すると単純かもです
ただA10まで必ずデータがある(またはそれ以上ない)とかなら別ですが
For Each myRange In Range("A2:A10")
よりも
m_Rows = Range("A" & Rows.Count).End(xlUp).Row
For Each myRange In Range("A2:A" & m_Rows)
とかにしたほうが良いと思います。

この回答へのお礼

ご回答ありがとうございます。
＞たとえば　C列に　=A2&B2　として下にフィル
＞コードのA2:A10をC2:C10とかに変更すると単純かもです
仰るとおり単純化できました。
あと、以下のコードも取り入れさせていただきます。
m_Rows = Range("A" & Rows.Count).End(xlUp).Row
For Each myRange In Range("A2:A" & m_Rows)

お礼日時：2010/04/25 16:18

No.3 回答者： Wendy02 回答日時： 2010/04/25 15:52

最初、同じコードの発想で良いのかと思いましたが、出身地が別だと、違う人ということのようなので、コードがまったく違ってしまいますね。

個人的なことですが、最近は不勉強なので、安直にCollection オブジェクトを使ってしまいました。本来は、このようなスタイル専用のアルゴリズムがあったような気がします。

'-------
Sub DupulicateChecking()
　Dim rng As Range
　　Dim ArNames() As String
　　Dim colNames As Collection
　　Dim n As Variant, i As Long, j As Long
　　
　　With ActiveSheet
　　　　'スタート範囲
　　　　Set rng = .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
　　End With
　　ReDim ArNames(0): ArNames(0) = "" 'ダミー
　　Set colNames = New Collection
　　For i = 1 To rng.Rows.Count
　　　　On Error Resume Next
　　　　With rng
　　　　　　n = .Cells(i, 1).Value & "、" & .Cells(i, 2).Value
　　　　End With
　　　　If Len(n) > 1 Then
　　　　　　colNames.Add i, n
　　　　End If
　　　　If Err.Number > 0 Then
　　　　　　ReDim Preserve ArNames(j)
　　　　　　ArNames(j) = i & "行目: " & n
　　　　　　j = j + 1
　　　　End If
　　　　On Error GoTo 0
　　Next
　　If ArNames(0) <> "" Then
　　　　MsgBox "同姓同名、同出身地あり、確認してください" & _
　　　　 vbCrLf & Join(ArNames, vbCrLf), vbExclamation
　　Else
　　　　MsgBox "重複はありませんでした。", vbInformation
　　End If
End Sub

この回答へのお礼

ご回答ありがとうございます。
ご教授いただいたコードで無事、解決しました。
私のレベルではよくわからないコードもあるので、今後勉強します。
お世話様でした。

お礼日時：2010/04/25 16:35

No.4 回答者： ap_2 回答日時： 2010/04/25 16:51

ANo.1は、"A1、B1"と結合して一度の比較にしてます。

効率いいです。

ただ、2度比較できないのは、一致したA列のアドレスを特定できないのかな・・・
A一致B不一致とかは、ANo.1じゃ対応できないので、↓参考になれば。

'a1～4はいずれもアドレス"$B$3"を返します。
a1 = Range("B3").Address
a2 = Range(a1).Address
a3 = Range("A3").Offset(0,1).Address '※縦0,横1移動したセルB3
a4 = Cells(3,2).Address


myRange.Offset(0,1)でB列比較がわかりやすいかと。
データ数でforループして、Cells(i,1)というのもよくある。

.Rowで縦と.Columun横の番号だけ取得も可能です。

No.5 回答者： ap_2 回答日時： 2010/04/25 16:51

ANo.1は、"A1、B1"と結合して一度の比較にしてます。

効率いいです。

ただ、2度比較できないのは、一致したA列のアドレスを特定できないのかな・・・
A一致B不一致とかは、ANo.1じゃ対応できないので、↓参考になれば。

'a1～4はいずれもアドレス"$B$3"を返します。
a1 = Range("B3").Address
a2 = Range(a1).Address
a3 = Range("A3").Offset(0,1).Address '※縦0,横1移動したセルB3
a4 = Cells(3,2).Address


myRange.Offset(0,1)でB列比較がわかりやすいかと。
データ数でforループして、Cells(i,1)というのもよくある。

.Rowで縦と.Columun横の番号だけ取得も可能です。

この回答へのお礼

ご回答ありがとうございます。

お礼日時：2010/04/26 21:22