VBA 最終行の取得がうまくいかず上書きされてしまいます。

Question

こんにちは。 Excelを使った日報を使っており、集計シートを作成しています。日報は1日ごとに1枚のシートを振り分けていて、必要項目だけを抽出して【1日】【2日】【3日】…と続けて集計シートに転記したいです。シート【1日】は問題なく転記出来たのですが、【2日】を転記すると【1日】のデータに上書きされてしまいます。【2日】以降を【集計シート】の最終行を取得して次の行から貼り付けていく方法を教えていただけないでしょうか？日毎の日報シートA列（非表示にしています）に抽出対象がありますが、こちらは【集計シート】へは表示していません。また【1日】から【31日】までのシートを連続で抽出貼り付けが出来るVBAも教えていただけると嬉しいです。ただシートは【月集計】と日毎のシート以外にもいくつかあるため（集計シートは実際の日報だと4枚目にあります）、「【月集計】以外のシートで指定」するコードは使えないです。 Sub 抽出3() '抽出 Dim i, j As Long i = 5 j = 3 With Worksheets("1日") Do While .Cells(i, "B").Value <> "" If .Cells(i, "A").Value <> "" Then For x = 1 To 13 Worksheets("月集計").Cells(j, x).Value = .Cells(i, x + 1).Value Next x j = j + 1 End If i = i + 1 Loop End With End Sub よろしくお願いします。

tatsumaru77 · Accepted Answer

No4です。
＞1．レイアウトですが、15行目、30行目にスペースがあります。なので設備2は16行目から、設備3は31行目から始まります。このスペースは削除可能です。

回答：B列に日付が入っていれば問題ないので、このままで構いません。

＞2.歯抜けを防ぐため非表示のB列5行目～44行目まで日付を入力しています。
＞3.B列には歯抜けを防ぐため日付が入ってるため空のセルはありません。
抽出条件はD列のNo.が30000以下の場合 A列に●が入るようにしてあり、その●がついた行だけを月集計のシートに転記していきたいのですが、可能でしょうか？

回答：上記の件、了解しました。
下記へアップしました。
不明点があれば、補足してください。
https://ideone.com/4OUJYW

tatsumaru77 · Answer

No1です。
補足ありがとうございました。
最終確認です。

１．レイアウト確認
日報シートのレイアウトは、以下の内容で間違いないでしょうか。
1行～2行　　　設備1
3行～4行　　　設備1の見出し
5行～14行　　 設備1のデータ
15行～17行　　設備2
18行～19行　　設備2の見出し
20行～29行　　設備2のデータ
30行～32行　　設備3
33行～34行　　設備3の見出し
35行～44行　　設備3のデータ

マクロが転記対象とするのは、以下の
5行～14行　　 設備1のデータ
20行～29行　　設備2のデータ
35行～44行　　設備3のデータ
になります。

２．設備ごとの処理
各設備のデータは、前詰めで格納されている前提です。歯抜けのデータ行はないものとします。
歯抜けの行があった場合は、その設備の処理を打ち切り、次の設備の処理に移ります。

例
設備1で
5行　データ有
6行　空行
7行　データ有
の場合、6行で歯抜けがあるので、5行のみ転記します。
7行目以降は転記せず、設備2の処理に移ります。

３．データの有無の判定
Ｂ列にデータがある場合、データ有の行と判定します。（Ａ列は参照しません）
Ｂ列が空の場合は、Ｃ列等にデータがあっても、空行とみなします。

上記の仕様で、宜しいでしょうか。

ありものがたり · Answer

j を Static にしたら？

Qchan1962 · Answer

部分的な回答です

>シート【1日】は問題なく転記出来たのですが、【2日】を転記すると【1日】のデータに上書きされてしまいます。
これは変数jが定数3から始まっている為です
変数ｊを月集計シートの最終行の下、新規行番号を取得するようにすれば良いです
変数宣言をするならしっかりと書きましょう
例

'抽出
Dim i As Long, j As Long
Dim x As Long

i = 5
j = Application.Max(Worksheets("月集計").Cells(Rows.Count, 1).End(xlUp).Row + 1, 3)

月集計シートの１列目を対象に最終行番号+1で新規行番号
End(xlUp).Row + 1で3より小さい行番号が取得された場合　
Max関数でスタート行ナンバー３を代入しています

＞また【1日】から【31日】までのシートを連続で抽出貼り付けが出来るVBAも教えていただけると嬉しいです。

表組を見ると単純な疑問が出てきますが、単純にA・B列の条件に合致する
1～13列内のセルデータを　ブック内の1日～31日シートで繰り返すならば

（条件が出そろっていないので）合理的ではないかも知れませんが
シート全部に対して条件を設けて実行すればよいですね

簡単に書き加えると
Sub 抽出3()

'抽出
Dim i As Long, j As Long
Dim x As Long, n As Long
Dim sh As Worksheet
Dim flag As Boolean

For Each sh In Worksheets
flag = False
For n = 1 To 31
If StrConv(sh.Name, vbNarrow) = StrConv(n & "日", vbNarrow) Then
flag = True
Exit For
End If
Next

If flag Then
i = 5
j = Application.Max(Worksheets("月集計").Cells(Rows.Count, 1).End(xlUp).Row + 1, 3)

With sh

Do While .Cells(i, "B").Value <> ""

If .Cells(i, "A").Value <> "" Then

For x = 1 To 13

Worksheets("月集計").Cells(j, x).Value = .Cells(i, x + 1).Value

Next x

j = j + 1

End If

i = i + 1

Loop

End With

End If
Next sh

End Sub

ブックや表組、VBA実行トリガ、データの扱いなどを見直した方が良さそうですが・・・

tatsumaru77 · Answer

不明点です。
１．左側の画像が月集計で、右側の画像が日報シート（1日、2日、・・・）でしょうか。
画像が不鮮明なので、状況がよくわかりません。
画像を別々にして、アップすると、多少は鮮明になります。
別々にアップしていただけませんでしょうか。（特に日報シートのほうを優先でお願いします）
尚、画像が不鮮明なのは、あなたのせいではありません。
このサイトに、大きい画像をアップすると、このサイトに仕様で不鮮明になってしまいます。

２．右側が日報シートの前提ですが、提示されたマクロをみると、
設置1のデータしか転記してないように見えます。
設置2、設置3は転記しなくて良いのでしょうか。
（書かれている字が読めないので、○○1、○○2、○○3の○○を設置と書いています）

３．１日のデータを転記する場合は、提示されたマクロになりますが、
２日以降は、どうされるつもりなのでしょうか。
With Worksheets("1日")の "1日"を毎回、"2日"とか"3日"とかに変えて、実行されるつもりでしょうか。

４．１日～３１日までのシートを連続で抽出貼り付けが出来るマクロも作成したいとのことですが、
今年の２月分なら、１日～２８日までになります。
２月分を処理するばあいでも、１日～３１日のシートを処理して良いのでしょうか。
その場合は、２９日以降のシートのデータ行は空にしておく必要があります。
もし、今年の２月分は、１日～２８日までにしたいということであれば、
処理対象となる年月（例２０２５年２月）の情報がどこかにないと、そのような処理ができなくなります。

５．日報シートのA列とB列の具体的な内容がわかりませんが、
１つの行で、考えられるデータの有無のケースは、
①A列がデータ有り、B列がデータ有りのケース
②A列がデータ有り、B列がデータ無しのケース
③A列がデータ無し、B列がデータ有りのケース
④A列がデータ無し、B列がデータ無しのケース

が考えられます。②③のケースもあるのでしょうか。
もし、ある場合は、転記対象になるのでしょうか、ならないのでしょうか。

VBA 最終行の取得がうまくいかず上書きされてしまいます。

No4です。

No1です。

j を Static にしたら？

部分的な回答です

不明点です。

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング