Excelで頭に文字をマクロで加える

質問

<http://okwave.jp/qa/q439461.html>
にて、次のVBAが紹介されていますが、(1)セルがブランクの場合にも文字が追加、(2)ダブリの文字がある場合には文字がダブリの数だけ追加されてしまいます。

Sub Macro1()
　For i = 1 To 100
Cells.Replace What:=Cells(i, "A"), _
Replacement:="1-" & Cells(i, "A")
Next i
End Sub

添付画像のように、セルの値がが無い（Nul）の場合には文字を加えない、そしてセルの値がダブっている場合では各々のセルの値にひとつだけ文字を加えるようにするには、どのように修正すればよいのでしょうか。
なお、Excelは2007を使用しています。

回答No.3

某HN クロメート(Chromate)（@CoalTar） · ベストアンサー

Sub Macro2()
　 　Dim i As Long
　 　For i = 2 To 100
　 　 If Range("A" & i) <> "" Then
　 　 　 　 　 　Range("A" & i).Value = "1-" & Range("A" & i).Value
　 　 End If
　 　Next i
End Sub
繰り返しに条件分岐を混ぜればよいと思います

お礼

CoalTarさん、有難うございます。希望通りでした！！！

回答No.2

NURU_osan

失礼、No.１で回答したものですがブランクのことを忘れていました。
回答を修正します。

Sub Macro1()
'変数宣言
Dim Str0 As String
Dim Str1 As String
Dim I As Long
Dim R0 As Long
Dim R1 As Long
'処理
For R0 = 1 To 100
　　Str0 = Cells(R0, 1).Value
'ブランク回避
　　If Str0 <> "" Then
　　'重複数をカウント
　　　　I=0
　　　　For R1 = 1 To R0
　　　　　　Str1=Cells(R1, 1).Value
　　　　　　If Len(Str0)>Len(Str1) Then
　　　　　　ElseIf Str0=Right(Str1, Len(Str0)) Then
　　　　　　　　I = I + 1
　　　　　　End If
　　　　Next R1
　　　　'記述
　　　　Cells(R0, 1).Value = I & "-" & Str0
　　End If
Next R0

End Sub

お礼

NURU_osanさん、有難うございます。勉強がてら自分なりに手を加えて試行してみたいと思います。

補足

NURU_osanさま、　早速ありがとうございます。
ブランクの方は希望通りだったのですが、残念ながらダブリの方は希望通りではありませんでした。
下のように、ダブリはすべて　1-003　になるように修正できないでしょうか。
よろしくお願いします。

1-項目番号
1-001
1-002
1-003
2-003
1-005
1-006

ではなく、

1-項目番号
1-001
1-002
1-003
1-003
1-005
1-006

のようにならないでしょうか。

回答No.1

NURU_osan

Sub Macro1()
'変数宣言
Dim Str0 As String
Dim Str1 As String
Dim I As Long
Dim R0 As Long
Dim R1 As Long
'処理
For R0 = 1 To 100
　　Str0 = Cells(R0, 1).Value
　　'重複数をカウント
　　I=0
　　For R1 = 1 To R0
　　　　Str1=Cells(R1, 1).Value
　　　　If Len(Str0)>Len(Str1) Then
　　　　ElseIf Str0=Right(Str1, Len(Str0)) Then
　　　　　　I = I + 1
　　　　End If
　　Next R1
　　'記述
　　Cells(R0, 1).Value = I & "-" & Str0

Next R0

End Sub