A列にＢ列の空白セル以外のセルの数だけ1から番号をふりたい。

質問

A列にＢ列の空白セル以外のセルの数だけ1から番号をふりたい。

WIN7 Excel2007でマクロ作成中です。Ａ列にＢ列の番号の入っているセル（空白セル以外の）の数だけ番号を入力したいのですが、下記コードで、うまく出来ません。どうしたらよろしいでしょうか。

Sub 行番号を入れる2()
Dim i As Integer
Dim fCnt As Long

'シートが保護されていたら保護を解除
If ActiveSheet.ProtectContents = True Then
ActiveSheet.Unprotect
End If
fCnt = WorksheetFunction.CountA(Sheets("一覧").Columns(2)) 'COUNTA関数でB列の入力セル数を求める。
For i = 1 To fCnt
Worksheets("一覧").Cells(i + 3, 1).Value = i
Next i
End Sub

回答No.3

myRange · ベストアンサー

見出し：１行目
データ：２行目～～

'-------------------------------------
Sub test()
　Dim R As Long
　Dim No As Long

　ActiveSheet.Unprotect

　For R = 2 To Cells(Rows.Count, "B").End(xlUp).Row
　　　If Cells(R, "B").Value <> "" Then
　　　　　No = No + 1
　　　　　Cells(R, "A").Value = No
　　　End If
　Next R

　ActiveSheet.Protect
End Sub
'---------------------------------------------

Protectの引数は省略。
以上です。

お礼

ありがとうございましたあ。思う通りに出来ました。感謝いたします。

回答No.2

bin-chan

＃１です。すみません、タイトルに書いてありましたね。

うまく行かないのは、for文が「Ｂ列の番号の入っているセル」までしか回らないこと。
正しくは「Ｂ列の番号の入っているセルの行」まで回すこと。

試験してないので、調整が必要かも。
fCnt=Sheets("一覧").Range("B65536").End(xlUp).Row

でもこのままだとB列の最後まで、A列連番が振られるので、連番用変数を追加で宣言し、
IF文でセルBがNULLでない時、１加算して設定すればよいでしょう。
あと、iはlongに変更してくださいね。32768行以降が扱えないから。

Sub 行番号を入れる2()

　’インデント（字下げ）明示のため、スペースは全角です。コピペの際は注意
　Dim i As long
　Dim fCnt As Long
　Dim nCount As Long

　'シートが保護されていたら保護を解除
　If ActiveSheet.ProtectContents = True Then
　　ActiveSheet.Unprotect
　End If

　'B列で入力されているセルの最終行を求める。
　fCnt=Sheets("一覧").Range("B65536").End(xlUp).Row

　nCount = 0

　For i = 1 To fCnt
　　if isnull(Worksheets("一覧").Cells(i + 3, 2)) = false　then
　　　nCount = nCount + 1
　　　Worksheets("一覧").Cells(i + 3, 1).Value = nCount
　　endif
　Next i

End Sub

補足

お手数掛けます。今ご指導いただいたコードを実行しましたが。Ｂ列が空白のセルまでナンバーがはいってしまいます。原因を究明中ですが、わかりません。お助けください。

回答No.1

bin-chan

下記のシートの場合、ご希望のできあがり具合は、次のどれ？

　A　B
1　　あ
2
3　　い

１）
　A　B
1 2　あ
2
3 2　い

２）
　A　B
1 1　あ
2
3 2　い

補足

お手数掛けます、Ｂ列顧客番号のある人だけ、Ａ列に1から番号を振りたいです。
Ｂ列の行は不特定の数で増減があります。
以上よろしくお願いします。

A　　 　　　B　　　　　C
整理Ｎｏ 顧客Ｎｏ 名前
1　　　　　19
2　　　　　21
3 　　　　22