teratail
回答率
85.35%
teratail header banner
teratail header banner
質問するログイン新規登録
トップVBAに関する質問別シートに該当したデータを転記したい

編集履歴

回答編集履歴

6

コメントを修正

2020/09/21 07:48

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -106,7 +106,7 @@
106
106
 
107
107
 
108
108
 
109
- '[貼付用]シートを[貼付用]の昇順、[降校時刻]の降順でソート
109
+ '[貼付用]シートを[出席番号]の昇順、[降校時刻]の降順でソート
110
110
 
111
111
 
112
112
 

5

コードを一部修正

2020/09/21 07:48

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -66,9 +66,9 @@
66
66
 
67
67
  Dim wshHari As Worksheet
68
68
 
69
- Dim lngRowHari As Long
69
+ Dim lngHariRow As Long
70
-
70
+
71
- Dim lngRowHariEnd As Long
71
+ Dim lngHariRowEnd As Long
72
72
 
73
73
  Dim varHari出席番号 As Variant
74
74
 
@@ -80,85 +80,87 @@
80
80
 
81
81
  Dim wshTenk As Worksheet
82
82
 
83
- Dim lngRowTenk As Long
83
+ Dim lngTenkRow As Long
84
-
84
+
85
- Dim lngRowTenkEnd As Long
85
+ Dim lngTenkRowEnd As Long
86
86
 
87
87
  Dim strTenk認定 As String
88
88
 
89
- Dim dctRow整理番号 As Dictionary
89
+ Dim dctTenk整理番号Row As Dictionary
90
90
 
91
91
  Dim wsh1gou As Worksheet
92
92
 
93
- Dim lngRow1gou As Long
93
+ Dim lng1gouRow As Long
94
-
95
- Dim str1gou児童名 As String
96
94
 
97
95
  Dim str1gou整理番号 As String
98
96
 
99
97
  Dim lng1gou朝夕区分 As Long
100
98
 
99
+ Set wshHari = Worksheets("貼付用")
100
+
101
+ Set wshTenk = Worksheets("転記")
102
+
103
+ Set wsh1gou = Worksheets("1号")
104
+
105
+ Set dctTenk整理番号Row = New Dictionary
106
+
101
107
 
102
108
 
109
+ '[貼付用]シートを[貼付用]の昇順、[降校時刻]の降順でソート
110
+
111
+
112
+
113
+ With wshHari.Sort
114
+
115
+ .SortFields.Clear
116
+
117
+ .SortFields.Add wshHari.Cells(1, ColHari出席番号), Order:=xlAscending
118
+
119
+ .SortFields.Add wshHari.Cells(1, ColHari降校時刻), Order:=xlDescending
120
+
103
- Set wshHari = Worksheets("貼付用")
121
+ .SetRange wshHari.Range(ColHari出席番号 & ":" & ColHari降校時刻)
104
-
122
+
105
- Set wshTenk = Worksheets("転記")
123
+ .Header = xlYes
124
+
106
-
125
+ .Apply
126
+
107
- Set wsh1gou = Worksheets("1号")
127
+ End With
108
-
128
+
129
+
130
+
109
- Set dctRow整理番号 = New Dictionary
131
+ '[転記]シートの[整理番号]の行番号をDictionaryに登録
132
+
133
+
134
+
135
+ lngTenkRowEnd = wshTenk.Cells(wshTenk.Rows.Count, ColTenk整理番号).End(xlUp).Row
136
+
137
+ For lngTenkRow = RowTenk明細 To lngTenkRowEnd
138
+
139
+ dctTenk整理番号Row.Add wshTenk.Cells(lngTenkRow, ColTenk整理番号).Value, lngTenkRow
140
+
141
+ Next lngTenkRow
142
+
143
+
144
+
145
+ '[1号]シートの更新
146
+
147
+
148
+
149
+ lng1gouRow = Row1gou明細 - 1
150
+
151
+ lngHariRowEnd = wshHari.Cells(wshHari.Rows.Count, ColHari出席番号).End(xlUp).Row
152
+
153
+ For lngHariRow = RowHari明細 To lngHariRowEnd
110
154
 
111
155
 
112
156
 
113
- '[貼付用]シートを[貼付用]の昇順、[降校時刻]の降順でソート
114
-
115
-
116
-
117
- With wshHari.Sort
118
-
119
- .SortFields.Clear
120
-
121
- .SortFields.Add wshHari.Cells(1, ColHari出席番号), Order:=xlAscending
122
-
123
- .SortFields.Add wshHari.Cells(1, ColHari降校時刻), Order:=xlDescending
124
-
125
- .SetRange wshHari.Range(ColHari出席番号 & ":" & ColHari降校時刻)
126
-
127
- .Header = xlYes
128
-
129
- .Apply
130
-
131
- End With
132
-
133
-
134
-
135
157
  '[転記]シートの[整理番号]の行番号を取得
136
158
 
137
159
 
138
160
 
139
- lngRowTenkEnd = wshTenk.Cells(wshTenk.Rows.Count, ColTenk整理番号).End(xlUp).Row
140
-
141
- For lngRowTenk = RowTenk明細 To lngRowTenkEnd
142
-
143
- dctRow整理番号.Add wshTenk.Cells(lngRowTenk, ColTenk整理番号).Value, lngRowTenk
144
-
145
- Next lngRowTenk
146
-
147
-
148
-
149
- '[1号]シートの更新
150
-
151
-
152
-
153
- lngRow1gou = Row1gou明細 - 1
154
-
155
- lngRowHariEnd = wshHari.Cells(wshHari.Rows.Count, ColHari出席番号).End(xlUp).Row
156
-
157
- For lngRowHari = RowHari明細 To lngRowHariEnd
158
-
159
- varHari出席番号 = wshHari.Cells(lngRowHari, ColHari出席番号).Value
161
+ varHari出席番号 = wshHari.Cells(lngHariRow, ColHari出席番号).Value
160
-
162
+
161
- If dctRow整理番号.Exists(varHari出席番号) = False Then
163
+ If dctTenk整理番号Row.Exists(varHari出席番号) = False Then
162
164
 
163
165
  MsgBox varHari出席番号 & "が存在しません。"
164
166
 
@@ -166,49 +168,49 @@
166
168
 
167
169
  End If
168
170
 
169
- lngRowTenk = dctRow整理番号.Item(varHari出席番号)
171
+ lngTenkRow = dctTenk整理番号Row.Item(varHari出席番号)
170
-
172
+
173
+
174
+
171
- strTenk認定 = wshTenk.Cells(lngRowTenk, ColTenk認定)
175
+ strTenk認定 = wshTenk.Cells(lngTenkRow, ColTenk認定)
172
-
176
+
173
- If (strTenk認定 = "新1号" Or strTenk認定 = "新2号" Or strTenk認定 = "新3号") And wshTenk.Cells(lngRowTenk, ColTenk在籍) = "有" Then
177
+ If (strTenk認定 = "新1号" Or strTenk認定 = "新2号" Or strTenk認定 = "新3号") And wshTenk.Cells(lngTenkRow, ColTenk在籍) = "有" Then
174
178
 
175
179
  '夕
176
180
 
177
- datHari降校時刻 = wshHari.Cells(lngRowHari, ColHari降校時刻).Value
181
+ datHari降校時刻 = wshHari.Cells(lngHariRow, ColHari降校時刻).Value
178
182
 
179
183
  If datHari降校時刻 >= TimeValue("15:30") Then
180
184
 
181
- lngHariDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
185
+ lngHariDay = Day(wshHari.Cells(lngHariRow, ColHari日付).Value)
182
-
183
- str1gou児童名 = wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value
184
186
 
185
187
  If str1gou整理番号 = varHari出席番号 Then
186
188
 
187
189
  If lng1gou朝夕区分 = 2 Then
188
190
 
189
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
191
+ wsh1gou.Cells(lng1gouRow, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
190
192
 
191
193
  Else
192
194
 
193
- wsh1gou.Cells(lngRow1gou - 1, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
195
+ wsh1gou.Cells(lng1gouRow - 1, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
194
196
 
195
197
  End If
196
198
 
197
199
  Else
198
200
 
199
- lngRow1gou = lngRow1gou + 1
201
+ lng1gouRow = lng1gouRow + 1
200
202
 
201
203
  str1gou整理番号 = varHari出席番号
202
204
 
203
205
  lng1gou朝夕区分 = 2
204
206
 
205
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
207
+ wsh1gou.Cells(lng1gouRow, Col1gou児童名).Value = wshTenk.Cells(lngTenkRow, ColTenk園児名).Value
206
-
208
+
207
- wsh1gou.Cells(lngRow1gou, Col1gou年齢).Value = wshTenk.Cells(lngRowTenk, ColTenk年齢).Value
209
+ wsh1gou.Cells(lng1gouRow, Col1gou年齢).Value = wshTenk.Cells(lngTenkRow, ColTenk年齢).Value
208
-
210
+
209
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
211
+ wsh1gou.Cells(lng1gouRow, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
210
-
212
+
211
- wsh1gou.Cells(lngRow1gou, Col1gou免除).Value = wshTenk.Cells(lngRowTenk, ColTenk免除).Value
213
+ wsh1gou.Cells(lng1gouRow, Col1gou免除).Value = wshTenk.Cells(lngTenkRow, ColTenk免除).Value
212
214
 
213
215
  End If
214
216
 
@@ -216,35 +218,33 @@
216
218
 
217
219
  '朝
218
220
 
219
- datHari登校時刻 = wshHari.Cells(lngRowHari, ColHari登校時刻).Value
221
+ datHari登校時刻 = wshHari.Cells(lngHariRow, ColHari登校時刻).Value
220
222
 
221
223
  If datHari登校時刻 < TimeValue("09:00") Then
222
224
 
223
- lngHariDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
225
+ lngHariDay = Day(wshHari.Cells(lngHariRow, ColHari日付).Value)
224
-
225
- str1gou児童名 = wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value
226
226
 
227
227
  If str1gou整理番号 = varHari出席番号 And lng1gou朝夕区分 = 1 Then
228
228
 
229
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari登校時刻, "hmm")
229
+ wsh1gou.Cells(lng1gouRow, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari登校時刻, "hmm")
230
230
 
231
231
  Else
232
232
 
233
- lngRow1gou = lngRow1gou + 1
233
+ lng1gouRow = lng1gouRow + 1
234
234
 
235
235
  str1gou整理番号 = varHari出席番号
236
236
 
237
237
  lng1gou朝夕区分 = 1
238
238
 
239
- wsh1gou.Cells(lngRow1gou, Col1gou時間帯).Value = 1
239
+ wsh1gou.Cells(lng1gouRow, Col1gou時間帯).Value = 1
240
-
240
+
241
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
241
+ wsh1gou.Cells(lng1gouRow, Col1gou児童名).Value = wshTenk.Cells(lngTenkRow, ColTenk園児名).Value
242
-
242
+
243
- wsh1gou.Cells(lngRow1gou, Col1gou年齢).Value = wshTenk.Cells(lngRowTenk, ColTenk年齢).Value
243
+ wsh1gou.Cells(lng1gouRow, Col1gou年齢).Value = wshTenk.Cells(lngTenkRow, ColTenk年齢).Value
244
-
244
+
245
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari登校時刻, "hmm")
245
+ wsh1gou.Cells(lng1gouRow, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari登校時刻, "hmm")
246
-
246
+
247
- wsh1gou.Cells(lngRow1gou, Col1gou免除).Value = wshTenk.Cells(lngRowTenk, ColTenk免除).Value
247
+ wsh1gou.Cells(lng1gouRow, Col1gou免除).Value = wshTenk.Cells(lngTenkRow, ColTenk免除).Value
248
248
 
249
249
  End If
250
250
 
@@ -252,7 +252,7 @@
252
252
 
253
253
  End If
254
254
 
255
- Next lngRowHari
255
+ Next lngHariRow
256
256
 
257
257
 
258
258
 
@@ -260,7 +260,7 @@
260
260
 
261
261
 
262
262
 
263
- Set dctRow整理番号 = Nothing
263
+ Set dctTenk整理番号Row = Nothing
264
264
 
265
265
  Set wsh1gou = Nothing
266
266
 

4

コード一部修正

2020/09/20 03:03

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -62,222 +62,214 @@
62
62
 
63
63
  Sub s_set1gou()
64
64
 
65
+
66
+
67
+ Dim wshHari As Worksheet
68
+
69
+ Dim lngRowHari As Long
70
+
71
+ Dim lngRowHariEnd As Long
72
+
73
+ Dim varHari出席番号 As Variant
74
+
75
+ Dim datHari登校時刻 As Date
76
+
77
+ Dim datHari降校時刻 As Date
78
+
79
+ Dim lngHariDay As Long
80
+
81
+ Dim wshTenk As Worksheet
82
+
83
+ Dim lngRowTenk As Long
84
+
85
+ Dim lngRowTenkEnd As Long
86
+
87
+ Dim strTenk認定 As String
88
+
89
+ Dim dctRow整理番号 As Dictionary
90
+
91
+ Dim wsh1gou As Worksheet
92
+
93
+ Dim lngRow1gou As Long
94
+
95
+ Dim str1gou児童名 As String
96
+
97
+ Dim str1gou整理番号 As String
98
+
99
+ Dim lng1gou朝夕区分 As Long
100
+
65
101
 
66
102
 
67
- Dim lngRowHari As Long
68
-
69
- Dim lngRowHariEnd As Long
70
-
71
- Dim lngRowTenk As Long
72
-
73
- Dim lngRowTenkEnd As Long
74
-
75
- Dim lngRow1gou As Long
76
-
77
- Dim lngRow1gouEnd As Long
78
-
79
- Dim str認定 As String
80
-
81
- Dim str児童名 As String
82
-
83
- Dim dat降校時刻 As Date
84
-
85
- Dim dat登校時刻 As Date
86
-
87
- Dim lngDay As Long
88
-
89
- Dim wshHari As Worksheet
103
+ Set wshHari = Worksheets("貼付用")
90
-
104
+
91
- Dim wshTenk As Worksheet
105
+ Set wshTenk = Worksheets("転記")
92
-
106
+
93
- Dim wsh1gou As Worksheet
107
+ Set wsh1gou = Worksheets("1号")
94
-
108
+
95
- Dim dctRow整理番号 As Dictionary
109
+ Set dctRow整理番号 = New Dictionary
96
-
97
- Dim var整理番号 As Variant
98
-
99
- Dim var児童名 As Variant
100
110
 
101
111
 
102
112
 
113
+ '[貼付用]シートを[貼付用]の昇順、[降校時刻]の降順でソート
114
+
115
+
116
+
117
+ With wshHari.Sort
118
+
119
+ .SortFields.Clear
120
+
121
+ .SortFields.Add wshHari.Cells(1, ColHari出席番号), Order:=xlAscending
122
+
123
+ .SortFields.Add wshHari.Cells(1, ColHari降校時刻), Order:=xlDescending
124
+
125
+ .SetRange wshHari.Range(ColHari出席番号 & ":" & ColHari降校時刻)
126
+
127
+ .Header = xlYes
128
+
129
+ .Apply
130
+
131
+ End With
132
+
133
+
134
+
135
+ '[転記]シートの[整理番号]の行番号を取得
136
+
137
+
138
+
139
+ lngRowTenkEnd = wshTenk.Cells(wshTenk.Rows.Count, ColTenk整理番号).End(xlUp).Row
140
+
141
+ For lngRowTenk = RowTenk明細 To lngRowTenkEnd
142
+
143
+ dctRow整理番号.Add wshTenk.Cells(lngRowTenk, ColTenk整理番号).Value, lngRowTenk
144
+
145
+ Next lngRowTenk
146
+
147
+
148
+
149
+ '[1号]シートの更新
150
+
151
+
152
+
153
+ lngRow1gou = Row1gou明細 - 1
154
+
155
+ lngRowHariEnd = wshHari.Cells(wshHari.Rows.Count, ColHari出席番号).End(xlUp).Row
156
+
157
+ For lngRowHari = RowHari明細 To lngRowHariEnd
158
+
159
+ varHari出席番号 = wshHari.Cells(lngRowHari, ColHari出席番号).Value
160
+
161
+ If dctRow整理番号.Exists(varHari出席番号) = False Then
162
+
163
+ MsgBox varHari出席番号 & "が存在しません。"
164
+
165
+ GoTo s_set1gou_Exit
166
+
167
+ End If
168
+
169
+ lngRowTenk = dctRow整理番号.Item(varHari出席番号)
170
+
171
+ strTenk認定 = wshTenk.Cells(lngRowTenk, ColTenk認定)
172
+
173
+ If (strTenk認定 = "新1号" Or strTenk認定 = "新2号" Or strTenk認定 = "新3号") And wshTenk.Cells(lngRowTenk, ColTenk在籍) = "有" Then
174
+
175
+ '夕
176
+
177
+ datHari降校時刻 = wshHari.Cells(lngRowHari, ColHari降校時刻).Value
178
+
179
+ If datHari降校時刻 >= TimeValue("15:30") Then
180
+
181
+ lngHariDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
182
+
183
+ str1gou児童名 = wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value
184
+
185
+ If str1gou整理番号 = varHari出席番号 Then
186
+
187
+ If lng1gou朝夕区分 = 2 Then
188
+
189
+ wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
190
+
191
+ Else
192
+
193
+ wsh1gou.Cells(lngRow1gou - 1, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
194
+
195
+ End If
196
+
197
+ Else
198
+
199
+ lngRow1gou = lngRow1gou + 1
200
+
201
+ str1gou整理番号 = varHari出席番号
202
+
203
+ lng1gou朝夕区分 = 2
204
+
205
+ wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
206
+
207
+ wsh1gou.Cells(lngRow1gou, Col1gou年齢).Value = wshTenk.Cells(lngRowTenk, ColTenk年齢).Value
208
+
209
+ wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
210
+
211
+ wsh1gou.Cells(lngRow1gou, Col1gou免除).Value = wshTenk.Cells(lngRowTenk, ColTenk免除).Value
212
+
213
+ End If
214
+
215
+ End If
216
+
217
+ '朝
218
+
219
+ datHari登校時刻 = wshHari.Cells(lngRowHari, ColHari登校時刻).Value
220
+
103
- Set wshHari = Worksheets("貼付用")
221
+ If datHari登校時刻 < TimeValue("09:00") Then
222
+
104
-
223
+ lngHariDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
224
+
105
- Set wshTenk = Worksheets("転記")
225
+ str1gou児童名 = wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value
226
+
106
-
227
+ If str1gou整理番号 = varHari出席番号 And lng1gou朝夕区分 = 1 Then
228
+
229
+ wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari登校時刻, "hmm")
230
+
231
+ Else
232
+
107
- Set wsh1gou = Worksheets("1号")
233
+ lngRow1gou = lngRow1gou + 1
234
+
108
-
235
+ str1gou整理番号 = varHari出席番号
236
+
237
+ lng1gou朝夕区分 = 1
238
+
239
+ wsh1gou.Cells(lngRow1gou, Col1gou時間帯).Value = 1
240
+
241
+ wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
242
+
243
+ wsh1gou.Cells(lngRow1gou, Col1gou年齢).Value = wshTenk.Cells(lngRowTenk, ColTenk年齢).Value
244
+
245
+ wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari登校時刻, "hmm")
246
+
247
+ wsh1gou.Cells(lngRow1gou, Col1gou免除).Value = wshTenk.Cells(lngRowTenk, ColTenk免除).Value
248
+
249
+ End If
250
+
251
+ End If
252
+
253
+ End If
254
+
255
+ Next lngRowHari
256
+
257
+
258
+
259
+ s_set1gou_Exit:
260
+
261
+
262
+
109
- Set dctRow整理番号 = New Dictionary
263
+ Set dctRow整理番号 = Nothing
264
+
265
+ Set wsh1gou = Nothing
266
+
267
+ Set wshTenk = Nothing
268
+
269
+ Set wshHari = Nothing
110
270
 
111
271
 
112
272
 
113
- '[貼付用]シートを[貼付用]の昇順、[降校時刻]の降順でソート
114
-
115
-
116
-
117
- With wshHari.Sort
118
-
119
- .SortFields.Clear
120
-
121
- .SortFields.Add wshHari.Cells(1, ColHari出席番号), Order:=xlAscending
122
-
123
- .SortFields.Add wshHari.Cells(1, ColHari降校時刻), Order:=xlDescending
124
-
125
- .SetRange wshHari.Range(ColHari出席番号 & ":" & ColHari降校時刻)
126
-
127
- .Header = xlYes
128
-
129
- .Apply
130
-
131
- End With
132
-
133
-
134
-
135
- '[転記]シートの[整理番号]の行番号を取得
136
-
137
-
138
-
139
- lngRowTenkEnd = wshTenk.Cells(wshTenk.Rows.Count, ColTenk整理番号).End(xlUp).Row
140
-
141
- For lngRowTenk = RowTenk明細 To lngRowTenkEnd
142
-
143
- dctRow整理番号.Add wshTenk.Cells(lngRowTenk, ColTenk整理番号).Value, lngRowTenk
144
-
145
- Next lngRowTenk
146
-
147
-
148
-
149
- '[1号]シートの更新
150
-
151
-
152
-
153
- lngRow1gou = Row1gou明細 - 1
154
-
155
- lngRowHariEnd = wshHari.Cells(wshHari.Rows.Count, ColHari出席番号).End(xlUp).Row
156
-
157
- For lngRowHari = RowHari明細 To lngRowHariEnd
158
-
159
- var整理番号 = wshHari.Cells(lngRowHari, ColHari出席番号).Value
160
-
161
- If dctRow整理番号.Exists(var整理番号) = False Then
162
-
163
- MsgBox var整理番号 & "が存在しません。"
164
-
165
- GoTo s_set1gou_Exit
166
-
167
- End If
168
-
169
- lngRowTenk = dctRow整理番号.Item(var整理番号)
170
-
171
- str認定 = wshTenk.Cells(lngRowTenk, ColTenk認定)
172
-
173
- If (str認定 = "新1号" Or str認定 = "新2号" Or str認定 = "新3号") And wshTenk.Cells(lngRowTenk, ColTenk在籍) = "有" Then
174
-
175
- '夕
176
-
177
- dat降校時刻 = wshHari.Cells(lngRowHari, ColHari降校時刻).Value
178
-
179
- If dat降校時刻 >= TimeValue("15:30") Then
180
-
181
- lngDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
182
-
183
- var児童名 = Split(wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value & vbTab & vbTab, vbTab)
184
-
185
- If var児童名(0) = CStr(wshHari.Cells(lngRowHari, ColHari出席番号).Value) Then
186
-
187
- If var児童名(1) = "2" Then
188
-
189
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat降校時刻, "hmm")
190
-
191
- Else
192
-
193
- wsh1gou.Cells(lngRow1gou - 1, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat降校時刻, "hmm")
194
-
195
- End If
196
-
197
- Else
198
-
199
- lngRow1gou = lngRow1gou + 1
200
-
201
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshHari.Cells(lngRowHari, ColHari出席番号).Value & vbTab & 2 & vbTab & wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
202
-
203
- wsh1gou.Cells(lngRow1gou, Col1gou年齢).Value = wshTenk.Cells(lngRowTenk, ColTenk年齢).Value
204
-
205
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat降校時刻, "hmm")
206
-
207
- wsh1gou.Cells(lngRow1gou, Col1gou免除).Value = wshTenk.Cells(lngRowTenk, ColTenk免除).Value
208
-
209
- End If
210
-
211
- End If
212
-
213
- '朝
214
-
215
- dat登校時刻 = wshHari.Cells(lngRowHari, ColHari登校時刻).Value
216
-
217
- If dat登校時刻 < TimeValue("09:00") Then
218
-
219
- lngDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
220
-
221
- var児童名 = Split(wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value & vbTab & vbTab, vbTab)
222
-
223
- If var児童名(0) = CStr(wshHari.Cells(lngRowHari, ColHari出席番号).Value) And var児童名(1) = "1" Then
224
-
225
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat登校時刻, "hmm")
226
-
227
- Else
228
-
229
- lngRow1gou = lngRow1gou + 1
230
-
231
- wsh1gou.Cells(lngRow1gou, Col1gou時間帯).Value = 1
232
-
233
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshHari.Cells(lngRowHari, ColHari出席番号).Value & vbTab & 1 & vbTab & wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
234
-
235
- wsh1gou.Cells(lngRow1gou, Col1gou年齢).Value = wshTenk.Cells(lngRowTenk, ColTenk年齢).Value
236
-
237
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat登校時刻, "hmm")
238
-
239
- wsh1gou.Cells(lngRow1gou, Col1gou免除).Value = wshTenk.Cells(lngRowTenk, ColTenk免除).Value
240
-
241
- End If
242
-
243
- End If
244
-
245
- End If
246
-
247
- Next lngRowHari
248
-
249
-
250
-
251
- '児童名の先頭に仮設定した整理番号と朝夕の区分を削除
252
-
253
-
254
-
255
- lngRow1gouEnd = wsh1gou.Cells(wsh1gou.Rows.Count, Col1gou児童名).End(xlUp).Row
256
-
257
- For lngRow1gou = Row1gou明細 To lngRow1gouEnd
258
-
259
- var児童名 = Split(wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value & vbTab & vbTab, vbTab)
260
-
261
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = var児童名(2)
262
-
263
- Next lngRow1gou
264
-
265
-
266
-
267
- s_set1gou_Exit:
268
-
269
-
270
-
271
- Set dctRow整理番号 = Nothing
272
-
273
- Set wsh1gou = Nothing
274
-
275
- Set wshTenk = Nothing
276
-
277
- Set wshHari = Nothing
278
-
279
-
280
-
281
273
  End Sub
282
274
 
283
275
  ```

3

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

2020/09/19 18:07

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -96,6 +96,8 @@
96
96
 
97
97
  Dim var整理番号 As Variant
98
98
 
99
+ Dim var児童名 As Variant
100
+
99
101
 
100
102
 
101
103
  Set wshHari = Worksheets("貼付用")
@@ -178,11 +180,11 @@
178
180
 
179
181
  lngDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
180
182
 
181
- str児童名 = wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value
183
+ var児童名 = Split(wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value & vbTab & vbTab, vbTab)
182
-
184
+
183
- If Left(str児童名, 4) = CStr(wshHari.Cells(lngRowHari, ColHari出席番号).Value) Then
185
+ If var児童名(0) = CStr(wshHari.Cells(lngRowHari, ColHari出席番号).Value) Then
184
-
186
+
185
- If Mid(str児童名, 5, 1) = "2" Then
187
+ If var児童名(1) = "2" Then
186
188
 
187
189
  wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat降校時刻, "hmm")
188
190
 
@@ -196,7 +198,7 @@
196
198
 
197
199
  lngRow1gou = lngRow1gou + 1
198
200
 
199
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshHari.Cells(lngRowHari, ColHari出席番号).Value & "2" & wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
201
+ wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshHari.Cells(lngRowHari, ColHari出席番号).Value & vbTab & 2 & vbTab & wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
200
202
 
201
203
  wsh1gou.Cells(lngRow1gou, Col1gou年齢).Value = wshTenk.Cells(lngRowTenk, ColTenk年齢).Value
202
204
 
@@ -216,9 +218,9 @@
216
218
 
217
219
  lngDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
218
220
 
219
- str児童名 = wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value
221
+ var児童名 = Split(wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value & vbTab & vbTab, vbTab)
220
-
222
+
221
- If Left(str児童名, 5) = wshHari.Cells(lngRowHari, ColHari出席番号).Value & "1" Then
223
+ If var児童名(0) = CStr(wshHari.Cells(lngRowHari, ColHari出席番号).Value) And var児童名(1) = "1" Then
222
224
 
223
225
  wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat登校時刻, "hmm")
224
226
 
@@ -228,7 +230,7 @@
228
230
 
229
231
  wsh1gou.Cells(lngRow1gou, Col1gou時間帯).Value = 1
230
232
 
231
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshHari.Cells(lngRowHari, ColHari出席番号).Value & "1" & wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
233
+ wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshHari.Cells(lngRowHari, ColHari出席番号).Value & vbTab & 1 & vbTab & wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
232
234
 
233
235
  wsh1gou.Cells(lngRow1gou, Col1gou年齢).Value = wshTenk.Cells(lngRowTenk, ColTenk年齢).Value
234
236
 
@@ -246,7 +248,7 @@
246
248
 
247
249
 
248
250
 
249
- '児童名の先頭に仮設定した整理番号4桁と朝夕の区分1桁を削除
251
+ '児童名の先頭に仮設定した整理番号と朝夕の区分を削除
250
252
 
251
253
 
252
254
 
@@ -254,9 +256,9 @@
254
256
 
255
257
  For lngRow1gou = Row1gou明細 To lngRow1gouEnd
256
258
 
257
- str児童名 = wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value
259
+ var児童名 = Split(wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value & vbTab & vbTab, vbTab)
258
-
260
+
259
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = Mid(str児童名, 6)
261
+ wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = var児童名(2)
260
262
 
261
263
  Next lngRow1gou
262
264
 

2

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

2020/09/19 08:53

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -94,6 +94,8 @@
94
94
 
95
95
  Dim dctRow整理番号 As Dictionary
96
96
 
97
+ Dim var整理番号 As Variant
98
+
97
99
 
98
100
 
99
101
  Set wshHari = Worksheets("貼付用")
@@ -152,7 +154,17 @@
152
154
 
153
155
  For lngRowHari = RowHari明細 To lngRowHariEnd
154
156
 
155
- lngRowTenk = dctRow整理番号.Item(wshHari.Cells(lngRowHari, ColHari出席番号).Value)
157
+ var整理番号 = wshHari.Cells(lngRowHari, ColHari出席番号).Value
158
+
159
+ If dctRow整理番号.Exists(var整理番号) = False Then
160
+
161
+ MsgBox var整理番号 & "が存在しません。"
162
+
163
+ GoTo s_set1gou_Exit
164
+
165
+ End If
166
+
167
+ lngRowTenk = dctRow整理番号.Item(var整理番号)
156
168
 
157
169
  str認定 = wshTenk.Cells(lngRowTenk, ColTenk認定)
158
170
 
@@ -250,6 +262,10 @@
250
262
 
251
263
 
252
264
 
265
+ s_set1gou_Exit:
266
+
267
+
268
+
253
269
  Set dctRow整理番号 = Nothing
254
270
 
255
271
  Set wsh1gou = Nothing

1

説明文の誤りを修正

2020/09/19 08:01

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -1,4 +1,4 @@
1
- [1番]シートの更新のコードです。
1
+ [1号]シートの更新のコードです。
2
2
 
3
3
  ```VBA
4
4