ｆ4から右方向に1から28ごとに連続番号を入れたい

質問

Windows7とExcel2007でマクロ作成中の初心者です。
(1)縦の行に連番を振るコードはたくさんありますが、横に連番を振る
コードは皆無です。

(2)教えて頂きたいのは、あるセルＦ4から、右横方向に1から28までの番号を振りたいです。そして２９番目からまた、右方向に1から28まで番号を振ります。これを繰り返します。

(3)ただし、今の番号を振る行の下の行の最終列までで終了したいです。
よろしくお願いします。

以下のような縦の例は数え切れないほどサンプルがあります。
Sub 横に番号を振る()
Dim i As Long
With ThisWorkbook.Worksheets(1)
For i = 1 To 28
.Cells(i, "A").Value = i
Next i
End With
End Sub

回答No.4

kagakusuki · ベストアンサー

次の様なやり方もあります。

Sub QNo9037494_f4から右方向に1から28ごとに連続番号を入れたい()

Dim FirstCell As Range, LastCell As Range, myRange As Range, c As Range

Set FirstCell = Range("F4")
Set LastCell = Cells(FirstCell.Row + 1, Columns.Count) _
.End(xlToLeft).Offset(-1)

If LastCell.Row < FirstCell.Row Then
MsgBox "データがありません。" & _
vbCrLf & "マクロを終了します。", _
vbExclamation, "データ無し"
End If

For Each c In Range(FirstCell, LastCell)
c.Value = 1 + (c.Column - FirstCell.Column) Mod 28
Next c

End Sub

回答No.5

kagakusuki

回答No.4です。
　申し訳御座いません。後で確認しました処、前回回答致しましたVBAの構文中に一部誤りあった事に気付きました。
　誤っていたのは、

If LastCell.Row < FirstCell.Row Then

という箇所で、正しくは

If LastCell.Column < FirstCell.Column Then

とすべきでした。
　この部分は、「番号を振る行の下の行の最終列」がF4セルがある列(F列)よりも左にあるのかどうかをIf～Then～Endifを使って判定するための部分です。
　「『番号を振る行の下の行の最終列』がF4セルがある列(F列)よりも左にある」という事は、即ち、「F5セルから右側にはデータが無い」という事ですので、判定がTrueの場合には番号を振るべきセルが存在しないと見做して

データがありません。
マクロを終了します。

という表示を出してから、マクロを終了する処理へと分岐させる為のものなのですが、縦と横を間違えてしまいました。

　後それから、誤りと言っても、動作に影響する事は無いものなのですが、

Dim FirstCell As Range, LastCell As Range, myRange As Range, c As Range

という箇所の中の

myRange As Range,

は不要でした。

　従って、正しくは次の様なVBAとなります。

Sub QNo9037494_f4から右方向に1から28ごとに連続番号を入れたい()

Dim FirstCell As Range, LastCell As Range, c As Range

Set FirstCell = Range("F4")
Set LastCell = Cells(FirstCell.Row + 1, Columns.Count) _
.End(xlToLeft).Offset(-1)

If LastCell.Column < FirstCell.Column Then
MsgBox "データがありません。" & _
vbCrLf & "マクロを終了します。", _
vbExclamation, "データ無し"
End If

For Each c In Range(FirstCell, LastCell)
c.Value = 1 + (c.Column - FirstCell.Column) Mod 28
Next c

End Sub

お礼

わざわざ、ありがとうございます。締め切った後からこのように手を差し伸べてくださり、うるうる涙です。この前のコードでエラーが出たと思います。（記憶確かでないですが・・）このコードをまた、研究して試してみたいと思います。本当にありがとうございました。

回答No.3

imogasi

Sub test01()
n = 1 '連番を初期化して１に
cr = Cells(5, 1000).End(xlToLeft).Columns
MsgBox cr '確認用
For j = 6 To cr 'Ｆ列第４行目から右列に連番代入
If (j - 6) Mod 28 = 0 Then '28までで１に戻る繰り返し
n = 1 '連番を１に戻す
End If
Cells(4, j) = n 'Ｆ列第４行目から右に連番代入
n = n + 1
Next j
End Sub
Ｆ５から横方向にデータがか言っているとして、なにかのデータを入れて、テスト。
結果は第４行目で１－２８を繰り返した。
（１）第５行目のデータのある最右列の捉え方。
（２）隣接する各列に代入する数字で１－２８の繰り返しにする方法。
の方がわかってないのではないかな。
--
(1)縦の行に連番を振るコードはたくさんありますが、横に連番を振る
コードは皆無です。
「行」の例でできたら、Ｃｅｌｌｓ（行、列）の表現法があるのだから、学習者は、類推して、考えて作り替えていると思う。すべて丸ごと本やＷＥＢで得ようとしてもできないよ。
プログラムの上達とは類推できる力（と想像する力）だと思う。特に入試問題などでもそうだ。
このコーナーの質問の回答に対してさえ、多かれ少なかれ、類推力がなければ、自分のケースに合して、役立たせられないのだ。
ーー
上記はありふれた典型的な場合の例データでテストをやったので、実際では特殊な例が起こらないか、考えてください。
＞下の行の最終列までで
その間に空白セルがないという前提です。
＞End(xlToLeft).を使えるのは
第１０００列までと仮定したコードです。状況によっては増やしてください。

回答No.2

CC_T

１,２）Cellsの意味をもう一度おさらいしてください。
書かれているコードの
.Cells(i, "A").Value
の（i,"A")の部分がそのまま（行,列）を指しています。
ですから例えばそこを(i,i)として実行すると、A1セルからB2セル、C3セル・・・と言う風に右下に向かって斜めに数値が入るわけです。
当然、(1,i)とすれば１行目のA～AL列に、（2,i)とすれば２行目に数値が入ります。

3）最終列を探す方法も幾つかありますが、その１つ。
　Last_Colum = Cells(B, Columns.Count).End(xlToLeft).Column
これは、指定した行の右端から検索していって入力済みのセルの列数を得るコードです。
Bの部分に「今の番号を振る行の下の行」番号を入れれば、Last_Columという変数に「番号を振る行の下の行の最終列」の数値が書き込まれますので、
Do while～Loop　や　for~next　など繰り返し処理を使って１列目からLast_Colum列まで繰り返し処理を実行させればよです。
　入れ子構造の繰り返し処理になります。

Sub 番号を振る()
Dim a As Integer, b As Integer, L As Integer
a = 0
b = 0

'どこまで続けるかを取得（ここでは入力済みの４行目を基準にする）
L = Cells(4, Columns.Count).End(xlToLeft).Column

'aがLに届くまで繰り返し処理
Do While a < L
　a = a + 1
　b = b + 1
　Cells(3, a).Value = b
　 'bが28になったらbの値はリセットしよう
　 If b >= 28 Then b = 0
Loop

End Sub

回答No.1

f272

> (1)縦の行に連番を振るコードはたくさんありますが、横に連番を振るコードは皆無です。

それは縦に連番ができるなら普通の人は横に連番も出来るからです。

> (2)教えて頂きたいのは、あるセルＦ4から、右横方向に1から28までの番号を振りたいです。そして２９番目からまた、右方向に1から28まで番号を振ります。これを繰り返します。

F4からAG4に番号をふる例です
Sub 横に番号を振る()
Dim i As Long
With ThisWorkbook.Worksheets(1)
For i = 1 To 28
.Cells(4, 5+i).Value = i ’'''''(4)行(5+i)列に値を入れる
Next i
End With
End Sub

> (3)ただし、今の番号を振る行の下の行の最終列までで終了したいです。

最終列を探す例をネットで探してください。