エクセルマクロでデータ出力の際の条件がうまく機能しません。

下記のコードで、データ出力時に条件に合うデータを上から順に詰めて出力していきたいのですが、条件に合わない場合の空白セルを含んで出力されてしまいます。
targetrowの記述周りがおかしいと思うのですが原因がわかりません。デバッグでエラーもありません。
どのように修正すれば上から順に詰めて出力できるでしょうか？
ご教授お願い致します。

Sub 勤務区分入力()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow As Long
Dim i As Long
Dim targetRow As Long

' シート1とシート2を設定
Set ws1 = ThisWorkbook.Sheets("入力シート")
Set ws2 = ThisWorkbook.Sheets("出力シート")

' シート1の最終行を取得
lastRow = ws1.Cells(ws1.Rows.Count, "F").End(xlUp).Row

' Sheet2のG列から上に向かってデータを埋めるための行を設定
targetRow = 7

' データを検査してコピー
For i = 9 To lastRow ' A2から最終行まで
If ws1.Cells(i, 6).Value = "日勤" And IsEmpty(ws1.Cells(i, 5).Value) Then
ws2.Cells(i - 2, 3).Value = "17:00～18:00"
ws2.Cells(i - 2, 4).Value = "17:00～"
ElseIf ws1.Cells(i, 6).Value = "6:45早出" And IsEmpty(ws1.Cells(i, 5).Value) Then
ws2.Cells(i - 2, 3).Value = "15:15～16:15"
ws2.Cells(i - 2, 4).Value = "15:15～"
ElseIf ws1.Cells(i, 6).Value = "11時遅出" And IsEmpty(ws1.Cells(i, 5).Value) Then
ws2.Cells(i - 2, 3).Value = "19:30～20:30"
ws2.Cells(i - 2, 4).Value = "19:30～"
End If

' 次の行に移動
targetRow = targetRow + 1
Next i

' リリースオブジェクト
Set ws1 = Nothing
Set ws2 = Nothing
End Sub

No.2 ベストアンサー 回答者： tatsumaru77 回答日時： 2023/09/30 13:58

以下のようにしてください。

Sub 勤務区分入力()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow As Long
Dim i As Long
Dim targetRow As Long

' シート1とシート2を設定
Set ws1 = ThisWorkbook.Sheets("入力シート")
Set ws2 = ThisWorkbook.Sheets("出力シート")

' シート1の最終行を取得
lastRow = ws1.Cells(ws1.Rows.Count, "F").End(xlUp).Row

' Sheet2の７行から下に向かってデータを埋めるための行を設定
targetRow = 7

' データを検査してコピー
For i = 9 To lastRow ' A2から最終行まで
If ws1.Cells(i, 6).Value = "日勤" And IsEmpty(ws1.Cells(i, 5).Value) Then
ws2.Cells(targetRow, 3).Value = "17:00～18:00"
ws2.Cells(targetRow, 4).Value = "17:00～"
targetRow = targetRow + 1
ElseIf ws1.Cells(i, 6).Value = "6:45早出" And IsEmpty(ws1.Cells(i, 5).Value) Then
ws2.Cells(targetRow, 3).Value = "15:15～16:15"
ws2.Cells(targetRow, 4).Value = "15:15～"
targetRow = targetRow + 1
ElseIf ws1.Cells(i, 6).Value = "11時遅出" And IsEmpty(ws1.Cells(i, 5).Value) Then
ws2.Cells(targetRow, 3).Value = "19:30～20:30"
ws2.Cells(targetRow, 4).Value = "19:30～"
targetRow = targetRow + 1
End If

Next i

' リリースオブジェクト
Set ws1 = Nothing
Set ws2 = Nothing
End Sub

この回答へのお礼

ご回答ありがとうございます。
targetRow = targetRow + 1がそれぞれの条件で必要だったのですね。
コードの全文記述ありがとうございます。
今後もよろしくお願いします。

お礼日時：2023/09/30 22:30

No.1 回答者： fujillin 回答日時： 2023/09/30 13:33

こんにちは

うまくいかないコードだけ見せられても、何をしたいのかよくわかりませんね。

なんとなくの雰囲気だけですが、おかしそうな点を挙げてみると・・

＞For i = 9 To lastRow ' A2から最終行まで
・コメントには「A2から」とあるけれど、多分、9行目からになっている。
・そのループ内でws2に転記している行は、「i - 2」行目となっていて、
　ws1の行番号依存なので、質問タイトルにある「抽出して（してないのかも？）
　詰めて転記」をしているとは思えない。
　抽出処理はなく、ws1の全行をなんらかの形で転記するのなら、
　ws1の行番号依存でもよさそうですけれど・・

＞targetRow = 7
・通常なら、転記先の行番号とかなのでしょうけれど、処理内で使用していない
　ので意味をもたない変数になっている。
　想像するところ、出力先の行番号はこの変数の示す行なのではないでしょうか。
　（↑勝手な妄想ですけれど・・）

＞条件に合わない場合の空白セルを含んで出力されてしまいます
・条件に合わない行（？）として扱われるのは、ご提示のループでは、IF及び
　ElseIfの条件で偽となる行は処理を行わずに、次の行に進むことになります。
　その条件の内容が、実際に処理をしないものと一致しているのか再確認
　してみましょう。


※ 何をしたいのか理解できない状態で回答していますので、あくまでもご参考までに。
※ もしも、ご自身でデバッグする気があるのなら、例えばブレークポイントを設定して、1行ずつ処理をさせてみて、思っていることと違う結果になった時の処理を調べてみるとかが考えられます。
さらには、ステップ実行を併用するなどで、原因となっている箇所を特定できるものと思います。

この回答へのお礼

ご回答ありがとうございます。

＞For i = 9 To lastRow ' A2から最終行まで
これはコメントのミスでした。

＞targetRow = 7
出力先の行番号と思って記載しておりました。。。。

＞条件に合わない場合の空白セルを含んで出力されてしまいます
＞条件に合わない行（？）として扱われるのは、ご提示のループでは、IF及びElseIfの条件で偽となる行は処理を行わずに、次の行に進むことになります。
IFとElseIFの条件が理解できていなかったみたいです。。。勉強します。

ご丁寧にありがとうございます。ステップ実行して調べたりはしたのですが、今度質問するときはもう少し詳細に分からないことを記述しようと思いました。ありがとうございました。

お礼日時：2023/09/30 22:30