重複チェック

質問

マクロ初心者です。（エクセル２００３使用）
Ａ列の管理番号が重複していたら、Ｃ列に☆をつけるようなマクロを作りたいのですが、うまくできません。
すみませんが、どなたか教えてください。

（Sheet1)
A 　　　 　　　　　B 　　　　 C
アカ154-7
アカ226-9 　　　　　　　☆
アカ446-0
アカ675-4 　　　　　　　☆
アカ669-8
アカ226-9 　　　　　　　☆
アカ118-5
アカ675-4 　　　　　　　☆
アカ226-9 　　　　　　　☆

（マクロ）
Sub 重複()

Dim 管理番号 As Variant
Dim motoSht As Worksheets
Dim セル範囲 As Range

With Sheets("Sheet1")
管理番号 = Sheet2.Range("A2").Value
Set セル範囲 = Range("A2:B65536").CurrentRegion.Find(管理番号, , LookAt:=xlWhole)

If 同じ管理番号があったら Then　　　　　　　　　　　
Range("A").CurrentRegion.Offset(2) = ☆
ElseIf Not セル範囲 Is Nothing Then
MsgBox "管理番号は、重複していません"
End If
End With
End Sub

ご回答よろしくお願いいたします。

回答No.4

van111

A列は連続したデータとし、途中に空白がないと見てよろしいでしょうか？
それならばこんな感じかな？

Sub test()
i = 1
Do While Cells(i, 1) <> ""
If Application.WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(1, 1).End(xlDown)), Cells(i, 1).Value) > 1 Then
Cells(i, 3).Value = "☆"
End If
i = i + 1
Loop
End Sub

回答No.3

van111

Sub test()
i = 1
Do While Cells(i, 1) <> ""
If Application.WorksheetFunction.CountIf(Range("A1: A" & i), Cells(i, 1).Value) > 1 Then
Cells(i, 3).Value = "☆"
End If
i = i + 1
Loop
End Sub

お礼

ご回答ありがとうございます。
２回目以降の重複に対して☆がつくのですが、はじめのにも☆をつけるとなると、ややこしくなりますでしょうか？
このコードで役立つのですが、もし１回目にも☆をつけられるようでしたら、教えてください。
よろしくお願いいたします。

回答No.2

AKARI0418

マクロで実行するなら以下のような感じです

Sub 重複()

'Dim 管理番号 As Variant
Dim motoSht As Worksheets
Dim セル範囲 As Range

Dim i As Long 'ループカウンタ
Dim j As Long 'ループカウンタ
Dim duplicateFlag As Boolean '重複有無判定
Const checkColumn As Long = 1 '比較列(A列)
Const writeColumn As Long = 3 '星を出力する列(C列)
Const checkValue As String = "☆" '重複チェック表示

With Sheets("Sheet1")
'管理番号 = Sheet2.Range("A2").Value
'Set セル範囲 = Range("A2:B65536").CurrentRegion.Find(管理番号, , LookAt:=xlWhole)
Set セル範囲 = Range(Cells(1, 1), _
Range(ActiveSheet.Cells(65536, 1), _
ActiveSheet.Cells(65536, 3)).End(xlUp))
duplicateFlag = False

For i = 1 To セル範囲.Rows.Count
For j = i To セル範囲.Rows.Count
If セル範囲(i, checkColumn) = セル範囲(j, checkColumn) Then
セル範囲(j, writeColumn) = checkValue
duplicateFlag = True
End If
Next j
Next i

If duplicateFlag Then
MsgBox "管理番号は、重複しています"
Else
MsgBox "管理番号は、重複していません"
End If
End With
End Sub

回答No.1

n-jun

☆をつけていくだけなら、

Sub try()

With Worksheets("Sheet1").Range("A2", Cells(Rows.Count, 1).End(xlUp)).Offset(, 2)
.Formula = "=IF(COUNTIF(" & .Offset(, -2).Address(1, 1) & ",A1)>1,""☆"","""")"
.Value = .Value
End With

End Sub

数式でCOUNTIF関数を利用してみるとか？