質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.46%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

7回答

3800閲覧

別シートに該当したデータを転記したい

yuka2020

総合スコア2

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

2クリップ

投稿2020/09/15 23:59

編集2020/09/19 04:44

お世話になります。
役所へ定型で報告をしなければならないのですが、
毎月100名以上の日別に特定条件にものを入力しなければならず、
作業に時間がかかる上に間違いが多いため
VBAで作業時間を短縮したいと考えています。
現状1日ずつのデータを別シートへの転記まではできたのですが、
31回繰り返すために、行を一つずらすたびにすべてのデータを直す必要があるのと、
特定条件が反映されないために困っています。
もし可能であるならば、どこを省略すればよいのか教えていただければ有難いです。
よろしくお願いいたします。

前提・実現したいこと

実現したいこと
シート1「貼付用」の名前、登校時間(1号認定のみ)、降校時間
シート2「転記用」の認定、年齢
をシート3「1号」とシート4「2号」へ下記の要件で転記。


<シート3>
下記のように入力されるようにしたいです。
イメージ説明
(1)シート2のC列が新1号,新2号,新3号のどれかで、
かつF列が有の人で、シート1で対象に登園時間が9:00より前に1度でも
来ている人をシート3に抽出して、下記のように転記。
時間帯には朝と入力され、該当者の名前、年齢、9時より前に来た日の時刻を入力。
(2)シート2のC列が新1号,新2号,新3号のどれかで、
かつF列が有の人で、シート1で対象に下校時間が15:30以降に1度でも
下校している人をシート3に抽出して、下記のように入力。
・15時半以降の場合には該当者の名前と年齢、15時半以降になった日の時刻をを入力。
※9;00より前に利用し、かつ15時30分(含む)を利用した人は2行記載される。
登校のみ、もしくは、下校のみ該当した場合は1行記載される。
非該当の人は転記されない。

<シート4>
イメージ説明
シート2のC列が1または標かつF列が有の人対象に抽出し、
(1)シート2が1の人は、1か月の間に1回でも16:30以降の場合
D,E列が1,FHに児童名、年齢、該当日の下校時刻(ex.1800)を転記
(2)シート2が標の人は、1か月の間に1回でも18:00以降の場合
D,E列が空白,F
Hに児童名、年齢、該当日の下校時刻(ex.1800)


転記するための情報のシートは2つあります。
シート1:貼付用(他ソフトからのCSVをそのまま貼付)
イメージ説明
A 整理番号(標準)
B 名前(標準)
C 所属(標準)
D 園(標準)
E 日付(date)
F  曜日(標準)
G 出欠(標準)
H 登校時刻(TIME)
I 外出時刻(TIME)
J 戻り時間(TIME)
K 下校時間(TIME)

シート2:転記用
イメージ説明
A 整理番号(標準)
B 名前(標準)
C 認定(標準)…1,新1号,新2号,新3号,標,空白のどれか
D 誕生日(日付)
F 年齢(=DATEDIF(D3,$G$2,"Y"))
F 在籍(標準) …有か無のどちらか
G2~Ak2 〇日(=IF(ISERROR(DATE($A$1,$B$1,〇)),"",IF(MONTH(DATE($A$1,$B$1,〇))=$B$1,DATE($A$1,$B$1,〇),""))
G3~Ak203 時間(TIME)
AL 免除(標準)…1か空白のどちらか

また転記先のシートの情報は下記のとおりです。
シート3:1号
イメージ説明
A 番号(標準)
BC 時間帯(標準)…朝か空白のどちらか
D
F 児童名(標準)
G,H 年齢(標準)
I25AM40 時刻(標準) 該当時刻を入力するが8:00だった場合800と表示
AN
AI 料金(標準)
AQ 実費(標準)
AR 利用料(標準)
AS,AT 利用日数(=IF(AND(D10<>D11,D11=D12),"",IF(D10=D11,SUM(AS10:AS11),AS11)))
AU,AV 免除(標準)

シート4:2号
イメージ説明
C 番号(標準)
D,E 標・短(標準) 1か空白のどちらか
F,G 児童名(標準)
I,J 年齢(標準)
K24~AO224 時刻(標準) 該当時刻を入力するが17:00だった場合1700と表示
AP~AR 金額(オリジナル数式を作成予定…同ではない場合は、相当長い数式を入力予定)
AS,AT 免除 1か空白のどちらか

以上です。

■■な機能を実装中に以下のエラーメッセージが発生しました。

発生している問題・エラーメッセージ

転記用に転記する際に、認定で該当する人のものだけを転記しようとしているが、誰も転記されない。 また、1日ごとのコードのため、一つ直すごとにすべての日にちを直す必要があるため、整理がつかなくなっています。

該当のソースコード

Sub 一日() Dim sh1, sh2 Set sh1 = Worksheets("貼付用") Set sh2 = Worksheets("転記") d = sh1.Range("A65536").End(xlUp).Row On Error Resume Next For i = 2 To d '--条件をかけて選別 If sh1.Cells(i, "G") = "出席" And sh1.Cells(i, "E") = sh2.Range("G2") And _ sh1.Cells(i, "K") <> "" Then t = sh1.Cells(i, "A") '---Sheet2で時刻行を探す For r = 2 To 200 If sh1.Cells(i, "A") = sh2.Cells(r, "A") Then Exit For Next r '--該当行の値をSheet2の時刻該当行セット Sheet2.Cells(r, "B") = sh1.Cells(i, "B") Sheet2.Cells(r, "G") = sh1.Cells(i, "K") End If Next i End Sub

試したこと

認定部分を反映させるために
Sub 一日()
Dim sh1, sh2
Set sh1 = Worksheets("貼付用")
Set sh2 = Worksheets("転記")
d = sh1.Range("A65536").End(xlUp).Row
On Error Resume Next
For i = 2 To d
'--条件をかけて選別
If sh2.Cells(i, "C") = "標" And sh1.Cells(i, "E") = sh2.Range("G2") And _
sh1.Cells(i, "K").Value > TimeSerial(17, 59, 99) Then
t = sh1.Cells(i, "A")
'---Sheet2で時刻行を探す
For r = 2 To 1000
If sh1.Cells(i, "A") = sh2.Cells(r, "A") Then Exit For
Next r
'--該当行の値をSheet2の時刻該当行セット
Sheet2.Cells(r, "B") = sh1.Cells(i, "B")
Sheet2.Cells(r, "G") = sh1.Cells(i, "K")
End If
Next i
End Sub

Sub 一日()
Dim sh1, sh2
Set sh1 = Worksheets("貼付用")
Set sh2 = Worksheets("転記")
d = sh1.Range("A65536").End(xlUp).Row
P_TIME = TimeValue("15:30")
S_TIME = TimeValue("16:30")
L_TIME = TimeValue("18:00")
Certification = sh1.Cells(i, "C")

Select Case Certification
Case Is = "標"
On Error Resume Next
For i = 2 To d
'--条件をかけて選別
If sh1.Cells(i, "G") = "出席" And sh1.Cells(i, "E") = sh2.Range("G2") And _
sh1.Cells(i, "k") >= L_TIME Then
t = sh1.Cells(i, "A")
'---Sheet2で整理番号を探す
For r = 2 To 1000
If sh1.Cells(i, "A") = sh2.Cells(r, "A") Then Exit For
Next r
'--該当行の値をSheet2の時刻該当行セット
Sheet2.Cells(r, "B") = sh1.Cells(i, "B")
Sheet2.Cells(r, "G") = sh1.Cells(i, "K")
End If
Next i

Case Is = "1"
On Error Resume Next
For i = 2 To d
'--条件をかけて選別
If sh1.Cells(i, "G") = "出席" And sh1.Cells(i, "E") = sh2.Range("G2") And _
sh1.Cells(i, "k") >= S_TIME Then
t = sh1.Cells(i, "A")
'---Sheet2で整理番号を探す
For r = 2 To 1000
If sh1.Cells(i, "A") = sh2.Cells(r, "A") Then Exit For
Next r
'--該当行の値をSheet2の時刻該当行セット
Sheet2.Cells(r, "B") = sh1.Cells(i, "B")
Sheet2.Cells(r, "G") = sh1.Cells(i, "K")
End If
Next i

Case Else
On Error Resume Next
For i = 2 To d
'--条件をかけて選別
If sh1.Cells(i, "G") = "出席" And sh1.Cells(i, "E") = sh2.Range("G2") And _
sh1.Cells(i, "k") >= P_TIME Then
t = sh1.Cells(i, "A")
'---Sheet2で整理番号を探す
For r = 2 To 1000
If sh1.Cells(i, "A") = sh2.Cells(r, "A") Then Exit For
Next r
'--該当行の値をSheet2の時刻該当行セット
Sheet2.Cells(r, "B") = sh1.Cells(i, "B")
Sheet2.Cells(r, "G") = sh1.Cells(i, "K")
End If
Next i
End Select
End Sub

---本来であれば、
転記シートに一度貼り付けシートの時刻を転記せずに、
そのまま必要部分をシート3およびシート2に転記できればよかったのですが、
一気に別シートまで条件付きでシートを転記する方法が思い浮かばず、
一度転記シートに時間を転記した後に
該当する人のみをート3及びシート4に転記しようとしました。
が、その行為自体は出来る方からすると2度手間かもしれませんので、
省けるのであれば省きたいです。

補足情報(FW/ツールのバージョンなど)

Excel 2019 windows10
ここにより詳細な情報を記載してください。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答7

0

ベストアンサー

一度に投稿できなかったので、2回目のぶんです。
前に投稿したモジュールに組み込んでください。

VBA

1Public Sub シート1号作成() 2 Dim sh3 As Worksheet 'sheet3 1号 3 Dim sh2 As Worksheet 'sheet2 転記 4 Dim maxrow3 As Long 'shett3 最大行 5 Dim maxrow2 As Long 'sheet2 最大行 6 Dim row3 As Long 'sheet3 行番号 7 Dim row2 As Long 'sheet2 行番号 8 Dim col2 As Long 'sheet2 列番号 9 Dim col3 As Long 'sheet3 列番号 10 Dim endday As Long '月末日 11 Dim wday As Long '処理日 12 Dim wctr As Long '処理件数 13 Dim nintei As String '認定 14 Application.ScreenUpdating = False 15 Application.Calculation = xlCalculationManual 16 17 Set sh3 = Worksheets("1号") 18 Set sh2 = Worksheets("転記") 19 maxrow3 = sh3.Cells(Rows.Count, "A").End(xlUp).Row 'sheet3 最終行を求める 20 maxrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row 'sheet2 最終行を求める 21 '当該月の月末日を取得 22 endday = day(DateSerial(sh2.Cells(1, "A").Value, sh2.Cells(1, "B").Value + 1, 0)) 23 'sheet3の11行以降をクリア 24 For row3 = 11 To maxrow3 25 sh3.Range("A" & row3 & ":AM" & row3).Value = "" 26 sh3.Range("AU" & row3).Value = "" 27 Next 28 row3 = 11 29 'シート2(転記シート)を全行処理する 30 For row2 = 3 To maxrow2 31 nintei = sh2.Cells(row2, "C").Value 32 If (nintei = "新1号" Or nintei = "新2号" Or nintei = "新3号") And sh2.Cells(row2, "F").Value = "有" Then 33 '下校時刻が15:30以降の日があるなら登録する 34 If sh2.Cells(row2, "BS").Value = "1" Then 35 sh3.Cells(row3, "A").Value = row3 - 10 '連番 36 sh3.Cells(row3, "B").Value = "" '時間帯 37 sh3.Cells(row3, "D").Value = sh2.Cells(row2, "B").Value '児童名 38 sh3.Cells(row3, "G").Value = sh2.Cells(row2, "E").Value '年齢 39 wctr = 0 40 '1日~月末日までの繰り返し 41 For wday = 1 To endday 42 col2 = 5 + 2 * wday + 1 43 col3 = 8 + wday 44 If CheckUpperTime(sh2.Cells(row2, col2).Value, 1530) = True Then 45 sh3.Cells(row3, col3).Value = 100 * Hour(sh2.Cells(row2, col2).Value) + Minute(sh2.Cells(row2, col2).Value) 46 wctr = wctr + 1 47 End If 48 Next 49 If wctr = 0 Then 50 MsgBox ("転記シートの" & row2 & "行が不正。15:30以降のデータが1件もありません。データが書き換えられています") 51 GoTo EXIT99 52 End If 53 sh3.Cells(row3, "AU").Value = sh2.Cells(row2, "BQ").Value '免除 54 row3 = row3 + 1 55 End If 56 If sh2.Cells(row2, "BR").Value = "1" Then 57 sh3.Cells(row3, "A").Value = row3 - 10 '連番 58 sh3.Cells(row3, "B").Value = "朝" '時間帯 59 sh3.Cells(row3, "D").Value = sh2.Cells(row2, "B").Value '児童名 60 sh3.Cells(row3, "G").Value = sh2.Cells(row2, "E").Value '年齢 61 wctr = 0 62 '1日~月末日までの繰り返し 63 For wday = 1 To endday 64 col2 = 5 + 2 * wday 65 col3 = 8 + wday 66 If CheckLowerTime(sh2.Cells(row2, col2).Value, 900) = True Then 67 sh3.Cells(row3, col3).Value = 100 * Hour(sh2.Cells(row2, col2).Value) + Minute(sh2.Cells(row2, col2).Value) 68 wctr = wctr + 1 69 End If 70 Next 71 If wctr = 0 Then 72 MsgBox ("転記シートの" & row2 & "行が不正。9:00前のデータが1件もありません。データが書き換えられています") 73 GoTo EXIT99 74 End If 75 sh3.Cells(row3, "AU").Value = sh2.Cells(row2, "BQ").Value '免除 76 row3 = row3 + 1 77 End If 78 End If 79 Next 80 MsgBox ("1号シート作成完了") 81EXIT99: 82 Application.Calculation = xlCalculationAutomatic 83 Application.ScreenUpdating = True 84End Sub 85 86Public Sub シート2号作成() 87 Dim sh4 As Worksheet 'sheet4 2号 88 Dim sh2 As Worksheet 'sheet2 転記 89 Dim maxrow4 As Long 'shett4 最大行 90 Dim maxrow2 As Long 'sheet2 最大行 91 Dim row4 As Long 'sheet4 行番号 92 Dim row2 As Long 'sheet2 行番号 93 Dim col2 As Long 'sheet2 列番号 94 Dim col4 As Long 'sheet4 列番号 95 Dim endday As Long '月末日 96 Dim wday As Long '処理日 97 Dim wctr As Long '処理件数 98 Dim nintei As String '認定 99 Dim etime As Long '下校判定時刻 100 Dim etime_e As String '下校判定時刻(エラーメッセージ用) 101 Dim etime_c As String '下校判定フラグのカラム位置 102 Dim hyou_tan As String '標・短設定 103 Application.ScreenUpdating = False 104 Application.Calculation = xlCalculationManual 105 106 Set sh4 = Worksheets("2号") 107 Set sh2 = Worksheets("転記") 108 maxrow4 = sh4.Cells(Rows.Count, "C").End(xlUp).Row 'sheet4 最終行を求める 109 maxrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row 'sheet2 最終行を求める 110 '当該月の月末日を取得 111 endday = day(DateSerial(sh2.Cells(1, "A").Value, sh2.Cells(1, "B").Value + 1, 0)) 112 'sheet4の15行以降をクリア 113 For row4 = 15 To maxrow4 114 sh4.Range("C" & row4 & ":AO" & row4).Value = "" 115 sh4.Range("AS" & row4).Value = "" 116 Next 117 row4 = 15 118 'シート2(転記シート)を全行処理する 119 For row2 = 3 To maxrow2 120 nintei = sh2.Cells(row2, "C").Value 121 etime = 0 122 If nintei = "1" Then 123 etime = 1630 124 etime_e = "16:30" 125 etime_c = "BT" 126 hyou_tan = "1" 127 End If 128 If nintei = "標" Then 129 etime = 1800 130 etime_e = "18:00" 131 etime_c = "BU" 132 hyou_tan = "" 133 End If 134 If etime <> 0 And sh2.Cells(row2, "F").Value = "有" Then 135 '下校時刻が16:30/18:00以降の日があるなら登録する 136 If sh2.Cells(row2, etime_c).Value = "1" Then 137 sh4.Cells(row4, "C").Value = row4 - 14 '連番 138 sh4.Cells(row4, "D").Value = hyou_tan '標・短 139 sh4.Cells(row4, "F").Value = sh2.Cells(row2, "B").Value '児童名 140 sh4.Cells(row4, "I").Value = sh2.Cells(row2, "E").Value '年齢 141 wctr = 0 142 '1日~月末日までの繰り返し(下校時刻の設定) 143 For wday = 1 To endday 144 col2 = 5 + 2 * wday + 1 145 col4 = 10 + wday 146 If CheckUpperTime(sh2.Cells(row2, col2).Value, etime) = True Then 147 sh4.Cells(row4, col4).Value = 100 * Hour(sh2.Cells(row2, col2).Value) + Minute(sh2.Cells(row2, col2).Value) 148 wctr = wctr + 1 149 End If 150 Next 151 If wctr = 0 Then 152 MsgBox ("転記シートの" & row2 & "行が不正。" & etime_e & "以降のデータが1件もありません。データが書き換えられています") 153 GoTo EXIT99 154 End If 155 sh4.Cells(row4, "AS").Value = sh2.Cells(row2, "BQ").Value '免除 156 row4 = row4 + 1 157 End If 158 End If 159 Next 160 MsgBox ("2号シート作成完了") 161EXIT99: 162 Application.Calculation = xlCalculationAutomatic 163 Application.ScreenUpdating = True 164End Sub 165 166'時間下限チェック(登校時間) 167Private Function CheckLowerTime(ByVal data_time As Variant, check_time As Long) As Boolean 168 CheckLowerTime = False 169 If data_time = "" Then Exit Function 170 If (Hour(data_time) * 100 + Minute(data_time)) < check_time Then 171 CheckLowerTime = True 172 Exit Function 173 End If 174End Function 175'時間上限チェック(下校時間) 176Private Function CheckUpperTime(ByVal data_time As Variant, check_time As Long) As Boolean 177 CheckUpperTime = False 178 If data_time = "" Then Exit Function 179 If (Hour(data_time) * 100 + Minute(data_time)) >= check_time Then 180 CheckUpperTime = True 181 Exit Function 182 End If 183End Function 184 185

投稿2020/09/20 05:08

tatsu99

総合スコア5470

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

yuka2020

2020/09/21 07:19

作成ありがとうございました! 何度か試していたのですが、 何故か転記シートにうまく転記ができず、 原因を探っていたら返信が遅くなり申し訳ありませんでした。 転記がうまくいかず、他の1号および2号への転記も確認がうまくいきませんでした。 申し訳ありません。 折角作って下さったのに、前提の私の知識およびスキルが足りないために ご迷惑をお掛けいたします。
tatsu99

2020/09/21 08:28

こちらで使用したテストデータのexcelファイルです。(Book416sampleコピー.xlsm) 下記サイトからダウンロードしてください。 こちらのファイルと比較すればなにか違いが判るかと思います。excel 2007版で作成しています。 https://firestorage.jp/download/8c2357d4caf36a5d630533b6604ace1ad225bb07 ダウンロードパスワード teratail
tatsu99

2020/09/21 08:43 編集

もし、あなたのテストデータが公開可能なら(個人情報を使用していない架空のデータであることが前提) どこかのファイル共有サイトにそのファイルアップをしていただければ、こちらで検証することは可能です。 その際は、そのファイルを右クリックしプロパティを表示後、個人情報の削除を行ったものをアップしてください。ちなみにこちらのexcelが2007なのでexcel2007で読める形式で保存していただくとありがたいです。
yuka2020

2020/09/23 02:55

ありがとうございました。 お蔭さまで検証することが出来ました。 ありがとうございました。 今月の集計からは時間をかけずにできそうです。 本当にありがとうございました。
tatsu99

2020/09/23 03:00

うまく、いって何よりです。 参考までに、転記シートへの転記がうまくいかなかったのは、何が原因だったのでしょうか。
yuka2020

2020/09/28 01:55

返信が遅くなり、申し訳ございません。 どこが違うのかそれぞれ検証していった結果、 元のデータ自身がオートフィルでリストかしたものを使用せず、 手打ちで異なるものを入力していたことが原因のようでした。 こちらのミスでお手数をお掛けしまして、申し訳りませんでした。 お蔭さまで、職員が数日係で拾い出し、拾い出し漏れ等の手間が相当削減されました。 ありがとうございます。
tatsu99

2020/09/28 01:58

了解しました。
guest

0

既に他の方から回答が出ていますが、参考までにリリースします。
転記シートは私が提示した形のレイアウトに変更してあることが前提になります。
(1日ぶんは登校時刻と下校時刻からなります。又、9:00前の登校、15:30,16:30,18:00以降の下校のフラグが付加されます)
1号シートのデータは11行から出力を開始します。
2号シートのデータは15行から出力を開始します。
1号シート、2号シートの1,2は半角が前提です。
認定の1、新1号、新2号、新3号の1,2,3は半角が前提です。
1号シートの時間帯ですが、9:00前の場合、"朝"を出力します。"1"ではありません。
1号、2号シートの番号も出力します。

kitasueさんのマクロとの違いは以下の点です。
1.貼付用シートに複数の月のデータがあっても問題ありません。該当月のデータのみをピックアップします。2.1号シート、及び2号シートの出力順は、転記シートに記述された児童の並び順です。(kitasueさんのは1号シートのみ整理番号順です。)
3・貼付用シートの並びはそのまま保持されます。(kitasueさんのは整理番号順に並べ替えられます。)
4.1号シート、及び2号シートの出力件数が前回と比べて少なくなっていても問題ありません。
(例として、前回100件出力し、今回80件の場合でも、余分な20件分はクリアされています。事前に1号シート、2号シートの出力部を
手作業でクリアしておく必要はありません)

Public Sub 転記シートへ転記()・・・・貼付用シートから転記シートへ転記
Public Sub シート1号作成()・・・・・転記シートを読み込み、1号シートを作成
Public Sub シート2号作成()・・・・・転記シートを読み込み、2号シートを作成

もし、全てを一気に行いたい場合は、以下のようなプロシージャを作成し追加してください。
Public Sub 一括処理()
Call 転記シートへ転記
Call シート1号作成
Call シート2号作成
End Sub
但し、実際に実行する場合は、エラーが発生しないことを十分に確認したのち、行ってください。
この一括処理は各処理でエラーがあっても、次の処理へ無条件に進みます。

VBA

1Option Explicit 2 3Public Sub 転記シートへ転記() 4 Dim sh1 As Worksheet 'sheet1 貼付用 5 Dim sh2 As Worksheet 'sheet2 転記 6 Dim maxrow1 As Long 'shett1 最大行 7 Dim maxrow2 As Long 'sheet2 最大行 8 Dim row1 As Long 'sheet1 行番号 9 Dim row2 As Long 'sheet2 行番号 10 Dim col2 As Long 'sheet2 列番号 11 Dim dicT As Object '連想配列(キー:整理番号 値:Sheet2の整理番号に対応する行番号) 12 Dim seiri As String '整理番号 13 Dim wyyyy As Long '西暦年 14 Dim wmm As Long '月 15 Application.ScreenUpdating = False 16 Application.Calculation = xlCalculationManual 17 18 Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義 19 Set sh1 = Worksheets("貼付用") 20 Set sh2 = Worksheets("転記") 21 maxrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row 'sheet1 最終行を求める 22 maxrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row 'sheet2 最終行を求める 23 'sheet2のデータクリア及び整理番号の記憶 24 For row2 = 3 To maxrow2 25 seiri = sh2.Cells(row2, "A").Value 26 dicT(seiri) = row2 '整理番号と行番号を登録 27 sh2.Range("G" & row2 & ":BP" & row2).Value = "" 'G~BPをクリア 28 sh2.Range("BR" & row2 & ":BU" & row2).Value = "" 'BR~BUをクリア 29 Next 30 'sheet1を全行処理する 31 For row1 = 2 To maxrow1 32 If sh1.Cells(row1, "G").Value = "出席" And sh1.Cells(row1, "K").Value <> "" Then 33 '整理番号がsheet2に存在するかチェックする 34 seiri = sh1.Cells(row1, "A").Value 35 If dicT.Exists(seiri) = False Then 36 MsgBox ("貼付用シート:" & row1 & "行の整理番号:" & seiri & "は転記シートに存在しません。処理を中止します。") 37 GoTo EXIT99 38 End If 39 '日付の年・月が転記シートの年・月に一致するかチェックする 40 wyyyy = Year(sh1.Cells(row1, "E").Value) 41 wmm = Month(sh1.Cells(row1, "E").Value) 42 If wyyyy = sh2.Cells(1, "A").Value And wmm = sh2.Cells(1, "B").Value Then 43 '年月が一致なら該当日へ登録する 44 row2 = dicT(seiri) 'sheet2の登録対象の行番号取得 45 col2 = day(sh1.Cells(row1, "E").Value) * 2 + 5 'sheet2の登録対象の列番号取得(該当日付の列) 46 '園児名登録 47 sh2.Cells(row2, "B").Value = sh1.Cells(row1, "B").Value 48 '登校時刻登録 49 sh2.Cells(row2, col2) = sh1.Cells(row1, "H").Value 50 '下校時刻登録 51 sh2.Cells(row2, col2 + 1) = sh1.Cells(row1, "K").Value 52 '登校時間チェック 53 If CheckLowerTime(sh1.Cells(row1, "H").Value, 900) = True Then 54 sh2.Cells(row2, "BR").Value = "1" 55 End If 56 '下校時間チェック 57 If CheckUpperTime(sh1.Cells(row1, "K").Value, 1530) = True Then 58 sh2.Cells(row2, "BS").Value = "1" 59 End If 60 If CheckUpperTime(sh1.Cells(row1, "K").Value, 1630) = True Then 61 sh2.Cells(row2, "BT").Value = "1" 62 End If 63 If CheckUpperTime(sh1.Cells(row1, "K").Value, 1800) = True Then 64 sh2.Cells(row2, "BU").Value = "1" 65 End If 66 End If 67 End If 68 Next 69 MsgBox ("転記シート設定完了") 70EXIT99: 71 Application.Calculation = xlCalculationAutomatic 72 Application.ScreenUpdating = True 73End Sub 74 75 76

投稿2020/09/20 05:05

tatsu99

総合スコア5470

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

[1号]シートの更新のコードです。

VBA

1Option Explicit 2 3Const RowHari明細 = 2 4Const ColHari出席番号 = "A" 5Const ColHari名前 = "B" 6Const ColHari日付 = "E" 7Const ColHari登校時刻 = "H" 8Const ColHari降校時刻 = "K" 9Const RowTenk明細 = 3 10Const ColTenk整理番号 = "A" 11Const ColTenk園児名 = "B" 12Const ColTenk認定 = "C" 13Const ColTenk年齢 = "E" 14Const ColTenk在籍 = "F" 15Const ColTenk1日 = "G" 16Const ColTenk免除 = "AL" 17Const Row1gou明細 = 11 18Const Col1gou時間帯 = "B" 19Const Col1gou児童名 = "D" 20Const Col1gou年齢 = "G" 21Const Col1gou1日 = "I" 22Const Col1gou免除 = "AU" 23Const Row2gou明細 = 15 24Const Col2gou標短 = "D" 25Const Col2gou児童名 = "F" 26Const Col2gou年齢 = "i" 27Const Col2gou1日 = "K" 28Const Col2gou免除 = "AS" 29 30Sub s_set1gou() 31 32 Dim wshHari As Worksheet 33 Dim lngHariRow As Long 34 Dim lngHariRowEnd As Long 35 Dim varHari出席番号 As Variant 36 Dim datHari登校時刻 As Date 37 Dim datHari降校時刻 As Date 38 Dim lngHariDay As Long 39 Dim wshTenk As Worksheet 40 Dim lngTenkRow As Long 41 Dim lngTenkRowEnd As Long 42 Dim strTenk認定 As String 43 Dim dctTenk整理番号Row As Dictionary 44 Dim wsh1gou As Worksheet 45 Dim lng1gouRow As Long 46 Dim str1gou整理番号 As String 47 Dim lng1gou朝夕区分 As Long 48 Set wshHari = Worksheets("貼付用") 49 Set wshTenk = Worksheets("転記") 50 Set wsh1gou = Worksheets("1号") 51 Set dctTenk整理番号Row = New Dictionary 52 53'[貼付用]シートを[出席番号]の昇順、[降校時刻]の降順でソート 54 55 With wshHari.Sort 56 .SortFields.Clear 57 .SortFields.Add wshHari.Cells(1, ColHari出席番号), Order:=xlAscending 58 .SortFields.Add wshHari.Cells(1, ColHari降校時刻), Order:=xlDescending 59 .SetRange wshHari.Range(ColHari出席番号 & ":" & ColHari降校時刻) 60 .Header = xlYes 61 .Apply 62 End With 63 64'[転記]シートの[整理番号]の行番号をDictionaryに登録 65 66 lngTenkRowEnd = wshTenk.Cells(wshTenk.Rows.Count, ColTenk整理番号).End(xlUp).Row 67 For lngTenkRow = RowTenk明細 To lngTenkRowEnd 68 dctTenk整理番号Row.Add wshTenk.Cells(lngTenkRow, ColTenk整理番号).Value, lngTenkRow 69 Next lngTenkRow 70 71'[1号]シートの更新 72 73 lng1gouRow = Row1gou明細 - 1 74 lngHariRowEnd = wshHari.Cells(wshHari.Rows.Count, ColHari出席番号).End(xlUp).Row 75 For lngHariRow = RowHari明細 To lngHariRowEnd 76 77'[転記]シートの[整理番号]の行番号を取得 78 79 varHari出席番号 = wshHari.Cells(lngHariRow, ColHari出席番号).Value 80 If dctTenk整理番号Row.Exists(varHari出席番号) = False Then 81 MsgBox varHari出席番号 & "が存在しません。" 82 GoTo s_set1gou_Exit 83 End If 84 lngTenkRow = dctTenk整理番号Row.Item(varHari出席番号) 85 86 strTenk認定 = wshTenk.Cells(lngTenkRow, ColTenk認定) 87 If (strTenk認定 = "新1号" Or strTenk認定 = "新2号" Or strTenk認定 = "新3号") And wshTenk.Cells(lngTenkRow, ColTenk在籍) = "有" Then 88'夕 89 datHari降校時刻 = wshHari.Cells(lngHariRow, ColHari降校時刻).Value 90 If datHari降校時刻 >= TimeValue("15:30") Then 91 lngHariDay = Day(wshHari.Cells(lngHariRow, ColHari日付).Value) 92 If str1gou整理番号 = varHari出席番号 Then 93 If lng1gou朝夕区分 = 2 Then 94 wsh1gou.Cells(lng1gouRow, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm") 95 Else 96 wsh1gou.Cells(lng1gouRow - 1, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm") 97 End If 98 Else 99 lng1gouRow = lng1gouRow + 1 100 str1gou整理番号 = varHari出席番号 101 lng1gou朝夕区分 = 2 102 wsh1gou.Cells(lng1gouRow, Col1gou児童名).Value = wshTenk.Cells(lngTenkRow, ColTenk園児名).Value 103 wsh1gou.Cells(lng1gouRow, Col1gou年齢).Value = wshTenk.Cells(lngTenkRow, ColTenk年齢).Value 104 wsh1gou.Cells(lng1gouRow, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm") 105 wsh1gou.Cells(lng1gouRow, Col1gou免除).Value = wshTenk.Cells(lngTenkRow, ColTenk免除).Value 106 End If 107 End If 108'朝 109 datHari登校時刻 = wshHari.Cells(lngHariRow, ColHari登校時刻).Value 110 If datHari登校時刻 < TimeValue("09:00") Then 111 lngHariDay = Day(wshHari.Cells(lngHariRow, ColHari日付).Value) 112 If str1gou整理番号 = varHari出席番号 And lng1gou朝夕区分 = 1 Then 113 wsh1gou.Cells(lng1gouRow, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari登校時刻, "hmm") 114 Else 115 lng1gouRow = lng1gouRow + 1 116 str1gou整理番号 = varHari出席番号 117 lng1gou朝夕区分 = 1 118 wsh1gou.Cells(lng1gouRow, Col1gou時間帯).Value = 1 119 wsh1gou.Cells(lng1gouRow, Col1gou児童名).Value = wshTenk.Cells(lngTenkRow, ColTenk園児名).Value 120 wsh1gou.Cells(lng1gouRow, Col1gou年齢).Value = wshTenk.Cells(lngTenkRow, ColTenk年齢).Value 121 wsh1gou.Cells(lng1gouRow, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari登校時刻, "hmm") 122 wsh1gou.Cells(lng1gouRow, Col1gou免除).Value = wshTenk.Cells(lngTenkRow, ColTenk免除).Value 123 End If 124 End If 125 End If 126 Next lngHariRow 127 128s_set1gou_Exit: 129 130 Set dctTenk整理番号Row = Nothing 131 Set wsh1gou = Nothing 132 Set wshTenk = Nothing 133 Set wshHari = Nothing 134 135End Sub

投稿2020/09/19 06:14

編集2020/09/21 07:48
kitasue

総合スコア314

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

yuka2020

2020/09/19 06:47

早速ありがとうございます。 1号シートに転記することが出来ました。 しかも、私が1日ずつ転記していたよりも、 ずっち速い速度で転記され非常に驚き、また感動しております。 本当にありがとうございました。 ただ、繰り返し転記途中で str認定 = wshTenk.Cells(lngRowTenk, ColTenk認定) アプリケーション定義またはオブジェクトの定義エラーです。 と表示され、他の認定(1や標)の後の認定などは表示されません。 これはなぜなのでしょうか?
kitasue

2020/09/19 07:40

(1) [貼付用]シートの[出席番号]が、[転記]シートの[整理番号]に存在しないことはありませんか? (2) [整理番号]は4桁の数字だと思うのですが、前に0のついた、例えば、0123とか、0019とかの番号もありますか?
kitasue

2020/09/19 08:02

キーが見つからなかった時に、見つからないキーを表示して、処理を中断するよう修正しました。
yuka2020

2020/09/19 08:18

ありがとうございます。 全てエラーなく転記することが出来ました。 ありがとうございました! また、エラー処理で中断するようにしてくださったお蔭で、 転記シートの園児名を追加忘れも防ぐことが出来るようになり 非常に助かりました。 ありがとうございます!
kitasue

2020/09/19 08:23

ごめんなさい。このプロシジャは番号が4桁であることを前提に作られています。
kitasue

2020/09/19 08:54

整理番号の不定長に対応しました。
yuka2020

2020/09/21 07:27 編集

ありがとうございます! 最初に出てくるものはうまく転記できるのですが、 途中のものが転記されません。 一度並び替えをしてした方がよろしいのでしょうか? お手数をとらせてしまい申し訳ありません。
kitasue

2020/09/21 07:47

[転記]シートへの転記を実行した後、この[1号]シートの更新を実行していただきたいのですが、大丈夫でしょうか。
kitasue

2020/09/21 08:13

サンプルの「日本海たかし」さんは、14時代の時刻が出力されてますが、出力するのは、15:30以降ではなかったでしょうか。
kitasue

2020/09/21 09:59

[転記]シートのF列は「有」になってますでしょうか。
yuka2020

2020/09/28 02:31

返信が遅くなりまして、申し訳ありません。 転記シート以降にしておりましたが、うまくいかない状況でした。 最初の数行はきちんと表示されるのですが、それ以降は「有」がきちんと入っていますが、 転記自体がされない状況でした。 折角考えてくださったにもかかわらず、ベストアンサーに指名せず申し訳ありませんでした。
guest

0

[2号]シートの更新のコードです。

VBA

1Option Explicit 2 3Const RowHari明細 = 2 4Const ColHari出席番号 = "A" 5Const ColHari名前 = "B" 6Const ColHari日付 = "E" 7Const ColHari登校時刻 = "H" 8Const ColHari降校時刻 = "K" 9Const RowTenk明細 = 3 10Const ColTenk整理番号 = "A" 11Const ColTenk園児名 = "B" 12Const ColTenk認定 = "C" 13Const ColTenk年齢 = "E" 14Const ColTenk在籍 = "F" 15Const ColTenk1日 = "G" 16Const ColTenk免除 = "AL" 17Const Row2gou明細 = 15 18Const Col2gou標短 = "D" 19Const Col2gou児童名 = "F" 20Const Col2gou年齢 = "i" 21Const Col2gou1日 = "K" 22Const Col2gou免除 = "AS" 23 24Sub s_set2gou() 25 Dim lngRowTenk As Long 26 Dim lngRowTenkEnd As Long 27 Dim lngRow2gou As Long 28 Dim lngCol As Long 29 Dim str認定 As String 30 Dim lngRowInc As Long 31 Dim dat時刻 As Date 32 33 Dim wshTenk As Worksheet 34 Dim wsh2gou As Worksheet 35 36 Set wshTenk = Worksheets("転記") 37 Set wsh2gou = Worksheets("2号") 38 39 lngRow2gou = Row2gou明細 40 lngRowTenkEnd = wshTenk.Cells(wshTenk.Rows.Count, ColTenk整理番号).End(xlUp).Row 41 For lngRowTenk = RowTenk明細 To lngRowTenkEnd 42 lngRowInc = 0 43 str認定 = wshTenk.Cells(lngRowTenk, ColTenk認定).Value 44 If (str認定 = "1" Or str認定 = "標") And wshTenk.Cells(lngRowTenk, ColTenk在籍).Value = "有" Then 45 For lngCol = 1 To 31 46 dat時刻 = wshTenk.Cells(lngRowTenk, ColTenk1日).Offset(, lngCol - 1).Value 47 If str認定 = "1" And dat時刻 >= TimeValue("16:30") Or _ 48 str認定 = "標" And dat時刻 >= TimeValue("18:00") Then 49 If lngRowInc = 0 Then 50 If str認定 = "1" Then 51 wsh2gou.Cells(lngRow2gou, Col2gou標短).Value = 1 52 End If 53 wsh2gou.Cells(lngRow2gou, Col2gou児童名).Value = wshTenk.Cells(lngRowTenk, ColTenk園児名).Value 54 wsh2gou.Cells(lngRow2gou, Col2gou年齢).Value = wshTenk.Cells(lngRowTenk, ColTenk年齢).Value 55 wsh2gou.Cells(lngRow2gou, Col2gou免除).Value = wshTenk.Cells(lngRowTenk, ColTenk免除).Value 56 End If 57 wsh2gou.Cells(lngRow2gou, Col2gou1日).Offset(, lngCol - 1).Value = Format(dat時刻, "hmm") 58 lngRowInc = 1 59 End If 60 Next lngCol 61 End If 62 lngRow2gou = lngRow2gou + lngRowInc 63 Next lngRowTenk 64 65 Set wsh2gou = Nothing 66 Set wshTenk = Nothing 67 68End Sub

投稿2020/09/19 03:21

kitasue

総合スコア314

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

yuka2020

2020/09/19 06:50 編集

早速ありがとうございます。 エラーは出ないのですが、2号のシートに転記することが出来ません。 私の下準備がたりないからなのでしょうか。 提案してくださったように、先に転記シートを修正してからの形にしないと反映されないのでしょうか。 教えていただけると幸いです。どうぞよろしくお願いいたします。
kitasue

2020/09/19 19:07 編集

ええと、転記シートの修正を提案されているのは、別の回答者の方ですねw (1) [貼付用]シートの[出席番号]が、[転記]シートの[整理番号]に存在しないことはありませんか? (2) [整理番号]は4桁の数字だと思うのですが、前に0のついた、例えば、0123とか、0019とかの番号もありますか?
yuka2020

2020/09/19 08:14

失礼いたしました。 番号は、4桁ではなく3桁や5桁の場合もあります。 最初から伝えればいいものを、お手数をとらせてしまい申し訳ありません。
kitasue

2020/09/19 08:21

番号の桁数は一定でないのですか。それでは、少なくとも私の提案の[1号]シートの更新のプロシジャは正確には動きません。 ところで、前ゼロのある0123とか、007とかはありますか?
yuka2020

2020/09/21 07:35

返信が遅くなりまして申し訳ありません。 754や16789などはありますが、0123のように初めに0がつくようなものはありません。 転記されたデータをチェックしていったら 1号同様途中で該当したものがうまく転記されない状況です。 転記シートのみシートにコピーで、他は標準モジュールに貼付する時点でまちがっていたのでしょうか。 知識不足で申し訳ありません。
kitasue

2020/09/21 07:46

> 転記シートのみシートにコピーで、他は標準モジュールに貼付する の意味が良く分からないのですが、この[2号]シートの更新は、[転記]シートへ転記した後、実行していただきたいのですが、大丈夫でしょうか。
guest

0

変更後の転記シートです。
緑の部分がマクロで設定する個所です。
転記シート

今考えているのは、以下の1案のほうです。
1案
転記シートへの転記の際は、登校時刻と下校時刻を無条件に全て設定する。
そして、1号と2号へ転記時に必要な時刻のみを設定する。

2案
転記シートへの転記の際、認定の内容を読み込み、1号、2号へ転記時に必要な時刻のみを設定する。
例1 認定が標の場合
下校時刻が18:00以降のみの下校時刻のみを転記シートへ設定する。
登校時刻はいかなる時刻であっても転記シートへ設定しない。
例2 認定が新1号、新2号、新3号の何れかの場合
登校時間が9:00より前の場合、登校時刻を転記シートへ設定する。
下校時刻は、15:30以降の場合、下校時刻を転記シートへ設定する。

1案であれば、転記シートに全ての情報があるので、後でチェックがきちんとできると考えています。
2案を望まれるのであれば、そのようにすることは可能です。

投稿2020/09/19 01:19

編集2020/09/19 02:42
tatsu99

総合スコア5470

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

yuka2020

2020/09/19 06:01

選択肢の幅を作って下さり、ありがとうございます。 別の資料提出の際には、全ての数値を記載してある場合も求められる時もあるので 1案でいただけると幸いです。 よろしくお願いいたします。
guest

0

とりあえず、まずは、[転記]シートへの転記の部分だけ作ってみました。
VBEの「ツール>参照設定」から「Microsoft Scripting Runtime」へ参照設定してください。
異なる月のデータの混在が無いことが前提です。

VBA

1Option Explicit 2 3Const RowHari明細 = 2 4Const ColHari出席番号 = "A" 5Const ColHari名前 = "B" 6Const ColHari日付 = "E" 7Const ColHari登校時刻 = "H" 8Const ColHari降校時刻 = "K" 9Const RowTenk明細 = 3 10Const ColTenk整理番号 = "A" 11Const ColTenk園児名 = "B" 12Const ColTenk認定 = "C" 13Const ColTenk年齢 = "E" 14Const ColTenk在籍 = "F" 15Const ColTenk1日 = "G" 16Const ColTenk免除 = "AL" 17 18Sub s_setTenk() 19 20 Dim lngRowHari As Long 21 Dim lngRowHariEnd As Long 22 Dim lngRowTenk As Long 23 Dim lngRowTenkEnd As Long 24 Dim wshHari As Worksheet 25 Dim wshTenk As Worksheet 26 Dim lngDay As Long 27 Dim dat降校時刻 As Date 28 Dim dctRow整理番号 As Dictionary 29 Dim var整理番号 As Variant 30 31 Set wshHari = Worksheets("貼付用") 32 Set wshTenk = Worksheets("転記") 33 Set dctRow整理番号 = New Dictionary 34 35 lngRowTenkEnd = wshTenk.Cells(wshTenk.Rows.Count, ColTenk整理番号).End(xlUp).Row 36 For lngRowTenk = RowTenk明細 To lngRowTenkEnd 37 dctRow整理番号.Add wshTenk.Cells(lngRowTenk, ColTenk整理番号).Value, lngRowTenk 38 Next lngRowTenk 39 40 lngRowHariEnd = wshHari.Cells(wshHari.Rows.Count, ColHari出席番号).End(xlUp).Row 41 For lngRowHari = RowHari明細 To lngRowHariEnd 42 var整理番号 = wshHari.Cells(lngRowHari, ColHari出席番号).Value 43 If dctRow整理番号.Exists(var整理番号) = False Then 44 MsgBox var整理番号 & "が存在しません。", vbExclamation 45 GoTo s_setTenk_Exit 46 End If 47 lngRowTenk = dctRow整理番号.Item(var整理番号) 48 wshTenk.Cells(lngRowTenk, ColTenk園児名).Value = wshHari.Cells(lngRowHari, ColHari名前).Value 49 If wshHari.Cells(lngRowHari, ColHari降校時刻).Value <> "" Then 50 lngDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value) 51 dat降校時刻 = wshHari.Cells(lngRowHari, ColHari降校時刻).Value 52 Select Case wshTenk.Cells(lngRowTenk, ColTenk認定) 53 Case "標" 54 If dat降校時刻 >= TimeValue("18:00") Then 55 wshTenk.Cells(lngRowTenk, ColTenk1日).Offset(, lngDay - 1) = wshHari.Cells(lngRowHari, ColHari降校時刻).Value 56 End If 57 Case "1" 58 If dat降校時刻 >= TimeValue("16:30") Then 59 wshTenk.Cells(lngRowTenk, ColTenk1日).Offset(, lngDay - 1) = wshHari.Cells(lngRowHari, ColHari降校時刻).Value 60 End If 61 Case "新1号", "新2号", "新3号" 62 If dat降校時刻 >= TimeValue("15:30") Then 63 wshTenk.Cells(lngRowTenk, ColTenk1日).Offset(, lngDay - 1) = wshHari.Cells(lngRowHari, ColHari降校時刻).Value 64 End If 65 End Select 66 End If 67 Next lngRowHari 68 69s_setTenk_Exit: 70 71 Set dctRow整理番号 = Nothing 72 Set wshTenk = Nothing 73 Set wshHari = Nothing 74 75End Sub

投稿2020/09/19 01:16

編集2020/09/19 07:54
kitasue

総合スコア314

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

yuka2020

2020/09/19 05:55

ありがとうございます! 転記シートへの転記ができました。 ただ、最後に赤い✖で400と出てしまい、そちらは無視してもよろしいのでしょうか。 そのためなのか、7行目以降は転記がされませんでした。
kitasue

2020/09/19 06:19

エラーメッセージは何と出ましたでしょうか。当方で発生するエラーは、[貼付用]シートの[出席番号]が、[転記]シートの[整理番号]に存在しない場合だけです。あとは、別の月のデータが混在しているとか。。。
kitasue

2020/09/19 06:38

[整理番号]は4桁の数字だと思うのですが、前に0のついた、例えば、0123とか、0019とかの番号もありますか?
kitasue

2020/09/19 08:02

キーが見つからなかった時に、見つからないキーを表示して、処理を中断するよう修正しました。
guest

0

回答ではありません。いくつか不明点があるので質問です。
1.サンプルの貼付用シートの日付は2020年9月ですが、転記用シートの日付は2020年10月です。
貼付用シートには9月とか10月とかの複数の月のデータがあるということでしょうか。
(転記用は2020年10月のみで、ひと月のデータだけということは理解できます)

2.貼付用シートの出席番号(整理番号)が、転記用シートに存在しないというケースはあり得ないと考えて良いですか。
(あるとしたら、データの記述ミス)

3.マクロで転記シートに転記するのは、下校時間と園児名であってますか。
また、次のステップでは、この転記シートのデータを読み込んで、1号、2号のデータを作成するマクロを作りたいということでしょうか。
(以降の質問はその前提での質問です)

4.1号シートの作成について
①「(1)シート2のC列が新1号,新2号,新3号のどれかで、
かつF列が有の人で、シート1で対象に登園時間が9:00より前に1度でも
来ている人をシート3に抽出して、下記のように入力。
時間帯には朝と入力され、該当者の名前、年齢、9時より前に来た日の時刻を入力。」
とありますが、その場合、必ず2行を出力するのですか。
1行目の時間帯は空白、各日付の時刻は下校時刻
2行目の時間帯は朝、各日付の時刻は登校

又「シート2のC列が新1号,新2号,新3号のどれかで、かつF列が有の人で、かつ登園時間が全て9:00以降の人」は、シート3に抽出しないのでしょうか。

②「(2)シート2のC列が新1号,新2号,新3号のどれかで、
かつF列が有の人で、シート1で対象に下校時間が15:30以降に1度でも
下校している人をシート3に抽出して、下記のように入力。」
とありますが、その場合、1行のみを出力するのですか。
(各日付の時刻は下校時刻だが、15:30以前の時刻も記入して良いのか。15:30以降の時刻のみ記入するのかが不明)
又15:30以降とは15:30を含むのか含まないのかが不明。

又「シート2のC列が新1号,新2号,新3号のどれかで、かつF列が有の人で、かつ下校時間が全て15:30以前の人」は、シート3に抽出しないのでしょうか。

③以下のケースの場合、どのようになりますか。(以下の人は全て、シート2のC列が新1号かつF列が有り)
Aさん 10月1日 登校9:00 下校14:00 以外の日は全て休み
Bさん 10月1日 登校8:00 下校14:00 以外の日は全て休み
Cさん 10月1日 登校9:00 下校16:30 以外の日は全て休み
Dさん 10月1日 登校8:00 下校16:30 以外の日は全て休み

5.2号シートの作成について
①「(1)シート2が1の人は、1か月の間に1回でも16:30以降D,E列が1,F~Hに児童名、該当日の下校時刻(ex.1800)」
とありますが、該当日の下校時刻のみ、出力すれば良いのですか。(下校時刻が16:30より前の日の個所は出力しない。)

②「(2)シート2が標の人は、1か月の間に1回でも18:00以降D,E列が空白,F~Hに児童名、該当日の下校時刻(ex.1800)」
とありますが、該当日の下校時刻のみ、出力すれば良いのですか。(下校時刻が18:00より前の日の個所は出力しない。)

以上が質問になります。
以下は質問ではありません。提案です。
役所へ提出するのは1号、2号のみで、貼付用シート、転記シートは提出しないと理解しました。
1号、2号のシートへ出力時、貼付用シートと転記用シートを参照していますが、これを転記用シートのみ参照するように
してはいかがでしょうか。
その為、以下のような情報が転記シートに追加になります。
①登校時刻
②登校判定フラグ(登校時刻が1日でも以上9:00以前の日があれば1、以外は空白)
③下校判定フラグ1(下校時刻が1日でも15:30以降の日があれば1、以外は空白)
④下校判定フラグ2(下校時刻が1日でも16:30以降の日があれば1、以外は空白)
⑤下校判定フラグ3(下校時刻が1日でも18:30以降の日があれば1、以外は空白)

以上。

投稿2020/09/18 09:40

編集2020/09/18 22:06
tatsu99

総合スコア5470

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

yuka2020

2020/09/18 23:01

ご確認ありがとうございます。 1についてですが、重くなるため9月なら9月だけにするようします。 2、はい。記載漏れはない前提ですが、もしあった場合は、シート2に該当がないことごわかると嬉しいです。 3、園児名と年齢と下校もしくは登校時間です。認定が1の方だけは、認定の1も転記したいです。 4①登校時間だけ該当する場合は1行の転記で大丈夫です。また、9時以降の方は転記しない形が、1番望ましいです。 F列の有かどうかは、転記後に数式で該当時間があるかどうかを判断してるだけなので、最初の時点では役にたたないです。 ②15時30分は含みます。該当者だけの抽出で大丈夫です。 ③A該当行なし B朝10月1日8:00 C10月1日16:30 D朝10月1日8:00 (二列目)10月1日16:30 5①1と名前と年齢と該当時刻のみです。それより前に帰った日は記載しない形です。 ②①同様その通りです。 転記用シートのみにしたいのですが、触る人間がパソコンが苦手なために、複雑なことをするとデータ削除がおきるため、シート①は別のソフトからCSV排出したデータを貼り付けるだけにしたいと考えています。一つ一つ入力てダブルチェックするにも数日かかっているということなので、今回それをなくすために作っております。数式とかも併用できればよいのですが、なるべく作業する人が触る項目が多くないようにできれば幸いです。よろしくお願いします。
tatsu99

2020/09/19 01:18

3の回答ですが、 年齢はマクロで設定ではなく、現在関数で設定しているので、それで良いかとおもいますが、いかがでしょうか。 下校もしくは登校時間とのことですが、登校8:00 下校16:30の場合、両方の時刻が対象となりますので、 2つのデータを格納する必要があります。転記シートの時刻は、登校と下校の2つを格納できるようにしないといけないと 考えますがいかがでしょうか。 3以外の回答については了解しました。 転記シートのフォーマットを添付図のようにしたいのですがいかがでしょうか。 緑の部分がマクロで設定する個所です。
tatsu99

2020/09/19 02:19

「認定が1の方だけは、認定の1も転記したいです。」 上記の意味が分かりません。この情報は貼付用シートにはないので、転記のしようがありません。 担当者のかたが直接転記用シートに1を打ち込むと理解していたのですが、違うのでしょうか。
yuka2020

2020/09/19 04:23

うまく理解と伝えることが出来ていなくて申し訳ありません。 はい、おっしゃる通り転記シートには自分で入力します。 シート2の認定で直接入力してある「1」というものに関しては、 シート4「2号」のシートでD、E列に転記されるようにしたいという意味です。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.46%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問