至急です。エクセルでの質問です。空白セルを無視してデータがあるセルに対して連番を自動的にふりたい！

至急で申し訳ございません。エクセルに詳しい方助けてください！
空白セルを無視してデータがあるセルに対して連番を自動的にふりたいのですが、下図のようにシートが複数あり各シートにまたがっていて（各シートNo.21～別シートのNo.20までで連番）採番しなければなりません。シートの枚数は２０シートぐらいですが増える予定です。
ご教授お願い申し上げます。

No.6 ベストアンサー 回答者： tatsu99 回答日時： 2018/09/15 23:17

No5です。

以下のようにしてください。
Public Sub 連番作成2()
Dim ws As Worksheet
Dim i As Long
Dim no As Long
Dim no2 As Long
Dim lrow As Long
Dim maxrow As Long
If MsgBox("連番を作成します", vbOKCancel) <> vbOK Then
Exit Sub
End If
no = 1
no2 = 1
For i = 1 To Worksheets.Count
Set ws = Worksheets(i)
maxrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
For lrow = 2 To maxrow
If ws.Cells(lrow, "A").Value = 21 Then
no = 1
End If
If ws.Cells(lrow, "B").Value <> "" Then
ws.Cells(lrow, "C").Value = no
no = no + 1
End If
Next
maxrow = ws.Cells(Rows.Count, "L").End(xlUp).Row
For lrow = 12 To maxrow
If ws.Cells(lrow, "L").Value = 21 Then
no2 = 1
End If
If ws.Cells(lrow, "M").Value <> "" Then
ws.Cells(lrow, "N").Value = no2
no2 = no2 + 1
End If
Next
Next
MsgBox ("完了")
End Sub

この回答へのお礼

ありがとうございます。
希望とおりの結果を得ることができそうです。
何度も手直しをして頂き、申し訳ございませんでした。
助かりました。感謝いたします。

お礼日時：2018/09/16 00:30

No.7 回答者： WindFaller 回答日時： 2018/09/15 23:18

こんばんは。

>行：12以降にデータ、列：L(No.),M(データ),N(連番)
ということは、データは13行目から？

Sheet1 の最初から、N13には、
=IF(M13<>"",COUNTA(OFFSET(M13,,,-MOD(L13,21)-1)),"")
L列の数字がある限りを、フィルコピーしてやります。

Sheet2 からは、N13から
=IF(M13<>"",COUNTA(OFFSET(M13,,,-MOD(L13,21)-1))+(L12<21)*$Q$1,"")
とおいて、M列の数字がある限りを、フィルコピーしてやります。

もし、裏技を使うならば、
Sheet2 ～Sheet20 まで、Contrl キーを押したまま、選択して、
L13～L42(または、L列の数字のある限り) をドラッグして選択します。
ファンクションキーの[F2]を押し、Ctrl キーを押して、Enterを入れると、同じ場所に選択したシート文、数式が全部入ります。
そうすれば、全部同じ数式が入力できます。

Sheet2 のセルのQ1 には、(この場所は任意です)
=INDEX(Sheet1!N:N,MATCH(10^10,Sheet1!N:N,1)

といれてやり、同じく、作業グループ状態のままで、[F2]を押して、Ctrlキーを押して、Enter を入れると、同じ数式が入ってしまいます。しかし、今回は、前のシートを受け継ぐ目的ですから、
Sheet3 の場合は、Sheet2 に、Sheet4の場合は、Sheet3 に変えて挙げます。
*シートそれぞれの数式を書き換えるのが面倒かとは思いますが、一気に入れるなら、マクロの処理になります。

例えば、Sheet3 -Q1
=INDEX(Sheet2!N:N,MATCH(10^10,Sheet2!N:N,1))

最後に、シートタブ－右クリックで作業グループの解除

これで出来上がりました。

この回答へのお礼

ご連絡ありがとうございます。
早速、試させていただきます。ご協力していただき、感謝いたします。
ありがとうございます。

お礼日時：2018/09/16 00:01

No.5 回答者： tatsu99 回答日時： 2018/09/15 22:13

>また今後、使用している表において項目等が追加されることが予想され、

>下記のような行/列になると思われます。
>その場合、頂いたマクロの構文はどのように変更されるのでしょうか？
>引き続きで、大変申し訳ございませんが、再度のご教授をお願い申し上げます。
>各々の表は、
>行：12以降にデータ、列：L(No.),M(データ),N(連番)

その場合、連番はC列の続きの連番をN列に振るのでしょうか。
それともN列の連番はC列の連番とは独立して振るのでしょうか。

この回答へのお礼

ご回答ありがとうございます。
今後については、「N列の連番はC列の連番とは独立して振る」こととなると思います。
お手数をお掛け致しまして申し訳ございませんが、何卒よろしくお願い申し上げます。

お礼日時：2018/09/15 23:05

No.4 回答者： tom04 回答日時： 2018/09/15 22:08

こんばんは！

横からお邪魔します。
各シートL・M列の12行目以降にデータがあり、結果をN列に表示すれば良いのですね。
尚、各シートの連番が20できっちり割り切れない場合は
次のシートの20番目まで連番を引き継ぐ！という解釈です。
（仮にSheet1の連番が50番で終わっていて、41番～50番目に1～3の連番がある場合は
次のシートの20番目までは「4」からその連番が続く！）

標準モジュールです。

Sub Sample1()
　Dim i As Long, k As Long, cnt As Long
　　Application.ScreenUpdating = False
　　　For k = 1 To Worksheets.Count
　　　　With Worksheets(k)
　　　　　For i = 12 To .Cells(Rows.Count, "L").End(xlUp).Row '//L列の12行目～最終行まで//
　　　　　　If .Cells(i, "M") <> "" Then
　　　　　　　cnt = cnt + 1
　　　　　　　.Cells(i, "N") = cnt
　　　　　　Else
　　　　　　　.Cells(i, "N") = ""
　　　　　　End If
　　　　　　If .Cells(i, "L") Mod 20 = 0 Then
　　　　　　　cnt = 0
　　　　　　End If
　　　　　Next i
　　　　End With
　　　Next k
　　Application.ScreenUpdating = True
　　　MsgBox "完了"
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

ご連絡ありがとうございます。
早速、試させていただきます。
ご協力していただき、感謝いたします。
ありがとうございます。

お礼日時：2018/09/15 23:36

No.3 回答者： tatsu99 回答日時： 2018/09/15 14:11

No2です。

一か所訂正です。
If ws.Cells(lrow, "A").Value = 20 Then
を
If ws.Cells(lrow, "A").Value = 21 Then
にして下さい。
失礼しました。

この回答へのお礼

早々のご回答ありがとうございます。
思ったとおりの結果が表示され、大変助かりました。
また今後、使用している表において項目等が追加されることが予想され、
下記のような行/列になると思われます。
その場合、頂いたマクロの構文はどのように変更されるのでしょうか？
引き続きで、大変申し訳ございませんが、再度のご教授をお願い申し上げます。

各々の表は、
行：12以降にデータ、列：L(No.),M(データ),N(連番)

お礼日時：2018/09/15 18:30

No.2 回答者： tatsu99 回答日時： 2018/09/15 13:36

以下のマクロを標準モジュールに登録してください。

A列に20の数値が必ずあることが前提です。
-----------------------------------------------
Option Explicit
Public Sub 連番作成()
Dim ws As Worksheet
Dim i As Long
Dim no As Long
Dim lrow As Long
Dim maxrow As Long
If MsgBox("連番を作成します", vbOKCancel) <> vbOK Then
Exit Sub
End If
no = 1
For i = 1 To Worksheets.Count
Set ws = Worksheets(i)
maxrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
For lrow = 2 To maxrow
If ws.Cells(lrow, "A").Value = 20 Then
no = 1
End If
If ws.Cells(lrow, "B").Value <> "" Then
ws.Cells(lrow, "C").Value = no
no = no + 1
End If
Next
Next
MsgBox ("完了")
End Sub

No.1 回答者： tatsu99 回答日時： 2018/09/15 13:04

マクロでなら可能かと思いますが、マクロ前提での補足要求です。

マクロ不可の場合は、補足不要です。
①連番が、赤線のところで１に戻りますが、どのような基準で１に戻るのでしょうか。
②連番は次のシートにも継続するように見えますが、それであってますか。
③全シートが連番割り振りの対象になりますがそれでよいですか。（連番を割り振りたくない特別なシートはないですか）
④連番は1番左側のシートから順に右側のシートへ割り振りますが、それでよいですか。

この回答へのお礼

ご回答ありがとうございます。
➀&②各シートA列のNo.20で締め、No.21より１に戻ります。それが次シートに繰りかえされます。
③連番を割り振りたくない特別なシートは、今のところありません。
④1番左側のシートから順に右側のシートへ割り振ることで問題ありません。シートは新しく左側に追加される予定です。
何卒よろしくお願い申し上げます。

お礼日時：2018/09/15 13:17