アプリ版:「スタンプのみでお礼する」機能のリリースについて

エクセルマクロで残業時間入力シートを作成しています。
1シートあたり8日分しか記載できないため、9日目以降は2枚目に書く必要があります。
下記のコードでは、1枚目が8日分(8行)埋まれば2枚目に移行し、2枚目も8日分(8行)埋まれば3枚目に移行するように組んでいるつもりです。
問題は、1枚目は上から順に8日分記載してくれるのですが、2枚目では記載する行が増えずに同じ行の上に上書きしてしまいます。つまり2枚目が埋まらないのです。下の方の「’出力行を増やす」が2枚目ではどうもうまく機能していないようです。
どのように改善すればよろしいでしょうか?ご指導のほどよろしくお願いします。

Sub 出力するコード()
Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim wsOutput2 As Worksheet
Dim wsOutput3 As Worksheet
Dim LastRow As Long
Dim DateRange As Range
Dim WeekdayRange As Range
Dim AbsenceRange As Range
Dim WorkTypeRange As Range
Dim DepartureTimeRange As Range
Dim OutputRow As Long

' 入力シートと出力シートを設定
Set wsInput = ThisWorkbook.Sheets("入力シート")
Set wsOutput = ThisWorkbook.Sheets("出力シート")
Set wsOutput2 = ThisWorkbook.Sheets("出力シート2")
Set wsOutput3 = ThisWorkbook.Sheets("出力シート3")

' 最終行を取得(B列のデータが入力されている最終行を基準にする)
LastRow = wsInput.Cells(wsInput.Rows.Count, "B").End(xlUp).Row

' 列の範囲を設定
Set DateRange = wsInput.Range("B9:B" & LastRow)
Set WeekdayRange = wsInput.Range("C9:C" & LastRow)
Set AbsenceRange = wsInput.Range("E9:E" & LastRow)
Set WorkTypeRange = wsInput.Range("F9:F" & LastRow)
Set DepartureTimeRange = wsInput.Range("I9:I" & LastRow)

' 出力行の初期化
OutputRow = 1


'シート2の出力初期化
Dim OutputRowSheet2 As Long
OutputRowSheet2 = 1

' シート3の出力行初期化
Dim OutputRowSheet3 As Long
OutputRowSheet3 = 1

' 行ごとにデータを検査
Dim i As Long
For i = 1 To LastRow - 8 ' ヘッダー行を除外するために -8 する
If (AbsenceRange.Cells(i).Value = "" And WorkTypeRange.Cells(i).Value = "日勤" And DepartureTimeRange.Cells(i).Value > TimeValue("17:15")) Or _
(AbsenceRange.Cells(i).Value = "" And WorkTypeRange.Cells(i).Value = "6:45早出" And DepartureTimeRange.Cells(i).Value > TimeValue("15:30")) Or _
(AbsenceRange.Cells(i).Value = "" And WorkTypeRange.Cells(i).Value = "11時遅出" And DepartureTimeRange.Cells(i).Value > TimeValue("19:45")) Then
If OutputRow <= 8 Then
' 出力シート1に記載
wsOutput.Cells(OutputRow + 6, 1).Value = DateRange.Cells(i).Value ' 日付
wsOutput.Cells(OutputRow + 6, 2).Value = WeekdayRange.Cells(i).Value ' 曜日
wsOutput.Cells(OutputRow + 6, 5).Value = DepartureTimeRange.Cells(i).Value ' 退勤時刻
Else
If OutputRowSheet2 <= 8 Then
' 出力シート2に記載
wsOutput2.Cells(OutputRowSheet2 + 6, 1).Value = DateRange.Cells(i).Value ' 日付
wsOutput2.Cells(OutputRowSheet2 + 6, 2).Value = WeekdayRange.Cells(i).Value ' 曜日
wsOutput2.Cells(OutputRowSheet2 + 6, 5).Value = DepartureTimeRange.Cells(i).Value ' 退勤時刻
Else
' 出力シート3に記載
wsOutput3.Cells(OutputRowSheet3 + 7, 1).Value = DateRange.Cells(i).Value ' 日付
wsOutput3.Cells(OutputRowSheet3 + 7, 2).Value = WeekdayRange.Cells(i).Value ' 曜日
wsOutput3.Cells(OutputRowSheet3 + 7, 5).Value = DepartureTimeRange.Cells(i).Value ' 退勤時刻
End If
OutputRowSheet2 = OutputRowSheet + 1

End If
' 出力行を増やす
OutputRow = OutputRow + 1
OutputRowSheet2 = OutputRowSheet + 1

End If
Next i

A 回答 (4件)

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



Sub 出力するコード()
Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim wsOutput2 As Worksheet
Dim wsOutput3 As Worksheet
Dim LastRow As Long
Dim DateRange As Range
Dim WeekdayRange As Range
Dim AbsenceRange As Range
Dim WorkTypeRange As Range
Dim DepartureTimeRange As Range
Dim OutputRow As Long

' 入力シートと出力シートを設定
Set wsInput = ThisWorkbook.Sheets("入力シート")
Set wsOutput = ThisWorkbook.Sheets("出力シート")
Set wsOutput2 = ThisWorkbook.Sheets("出力シート2")
Set wsOutput3 = ThisWorkbook.Sheets("出力シート3")

' 最終行を取得(B列のデータが入力されている最終行を基準にする)
LastRow = wsInput.Cells(wsInput.Rows.Count, "B").End(xlUp).Row

' 列の範囲を設定
Set DateRange = wsInput.Range("B9:B" & LastRow)
Set WeekdayRange = wsInput.Range("C9:C" & LastRow)
Set AbsenceRange = wsInput.Range("E9:E" & LastRow)
Set WorkTypeRange = wsInput.Range("F9:F" & LastRow)
Set DepartureTimeRange = wsInput.Range("I9:I" & LastRow)

' 出力行の初期化
OutputRow = 1

' 行ごとにデータを検査
Dim i As Long
For i = 1 To LastRow - 8 ' ヘッダー行を除外するために -8 する
If (AbsenceRange.Cells(i).Value = "" And WorkTypeRange.Cells(i).Value = "日勤" And DepartureTimeRange.Cells(i).Value > TimeValue("17:15")) Or _
(AbsenceRange.Cells(i).Value = "" And WorkTypeRange.Cells(i).Value = "6:45早出" And DepartureTimeRange.Cells(i).Value > TimeValue("15:30")) Or _
(AbsenceRange.Cells(i).Value = "" And WorkTypeRange.Cells(i).Value = "11時遅出" And DepartureTimeRange.Cells(i).Value > TimeValue("19:45")) Then
Dim sheet_no As Long
Dim row_no As Long
Dim wsout As Worksheet
sheet_no = (OutputRow - 1) \ 8 + 1
row_no = OutputRow Mod 8
If row_no = 0 Then row_no = 8
If sheet_no = 1 Then Set wsout = wsOutput
If sheet_no = 2 Then Set wsout = wsOutput2
If sheet_no = 3 Then Set wsout = wsOutput3
wsout.Cells(row_no + 6, 1).Value = DateRange.Cells(i).Value ' 日付
wsout.Cells(row_no + 6, 2).Value = WeekdayRange.Cells(i).Value ' 曜日
wsout.Cells(row_no + 6, 5).Value = DepartureTimeRange.Cells(i).Value ' 退勤時刻
' 出力行を増やす
OutputRow = OutputRow + 1
End If
Next i
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございます。完全にいめーじ通りの挙動になりました。ご丁寧にありがとうございました。

お礼日時:2023/09/30 13:05

まあ、様式が決まっているのだろうとは推測はしていました。



ならば、
 For~Next
を使わずに記述してみることを勧めます。
そのうえで、
 For~Next
でまとめられる箇所を後からまとめるようにしてみましょう。

繰り返し処理の中で適切に処理が行われていないことが原因ですからね。
繰り返し処理を使わずにコードを書いてみるのです。
無駄に思えるかもしれませんが、意図した動作をしないときは、
確実に動作する形を作ってそこから修正することを勧めます。

様式が決まっているなら垂れ流しのコードでも終端はありますので、普通に作れるはずです。
↑様式が決まっている……が推測だったためこのアドバイスができませんでした。
    • good
    • 0
この回答へのお礼

最初に様式が決まっているとお伝えしていれば良かったですね。。。すみません。
繰り返し処理を行なわない…という発想もあるのですね!
ありがとうございます。

お礼日時:2023/09/30 13:04

こんばんは



基本的に、No1様の回答に1票です。

>2枚目ではどうもうまく機能していないようです。
直接の原因は、
>OutputRowSheet2 = OutputRowSheet + 1
の右辺の OutputRowSheet という変数がどこにも無いので、多分0と見做されているのではないかと推測します。

どうしても3シートにしたいにしても、同じことを何度も記述するのはあまり効率の良い書き方とは言えません。
記入先を変数にしておけば、そこを入れ替えるだけでシートを変更できることになるので、転記の記述をダブらないようにすることができるでしょう。

意味がわからなければ、
 1)一旦、シート1に全部記入してしまい。
 2)9~16行をまとめてシート2にカット&ペースト
 3)17~24行をまとめてシート3にカット&ペースト
という手順にしておくことで、2)、3)は1センテンスで済むので、ほぼ重複した記述をしなくても済むようになりそうな気がします。
(↑は、シートの他の部分の状態が不明なので、うまくいくのか不明ですけれど・・)
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます。
一旦シート1にまとめ、9行目からシート2に入力していくやりかたで行います。
ありがとうございました。

お礼日時:2023/09/29 09:10

ごめん。

そもそもの話になります。

(´・ω・`) シートを分ける必要ないような気がするんですけど...。

ページ設定で「印刷タイトル行」を決めておけば、あとは下にデータを並べるだけで良いよね。

そして「ページレイアウト」で表示すれば良いんじゃね?
シートを分ける必要はそれでなくなるような気がするのです。
    • good
    • 0
この回答へのお礼

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

分ける必要があります。様式が決まっているため時刻データの羅列を単に分割して印刷するわけにはいかないのです。

また、出力する時刻データも毎日分ではなく、残業のあった日のみ抽出してくる必要があるため、条件にあった時刻データを見つけて、様式の上から順に記載し、1枚目が埋まれば2枚目への記述…という形になっています。

お礼日時:2023/09/29 08:14

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

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


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