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

編集履歴

回答編集履歴

6

コメントを修正

2020/09/21 07:48

投稿

kitasue
kitasue

スコア314

answer CHANGED
@@ -52,7 +52,7 @@
52
52
  Set wsh1gou = Worksheets("1号")
53
53
  Set dctTenk整理番号Row = New Dictionary
54
54
 
55
- '[貼付用]シートを[貼付用]の昇順、[降校時刻]の降順でソート
55
+ '[貼付用]シートを[出席番号]の昇順、[降校時刻]の降順でソート
56
56
 
57
57
  With wshHari.Sort
58
58
  .SortFields.Clear

5

コードを一部修正

2020/09/21 07:48

投稿

kitasue
kitasue

スコア314

answer CHANGED
@@ -32,27 +32,25 @@
32
32
  Sub s_set1gou()
33
33
 
34
34
  Dim wshHari As Worksheet
35
- Dim lngRowHari As Long
35
+ Dim lngHariRow As Long
36
- Dim lngRowHariEnd As Long
36
+ Dim lngHariRowEnd As Long
37
37
  Dim varHari出席番号 As Variant
38
38
  Dim datHari登校時刻 As Date
39
39
  Dim datHari降校時刻 As Date
40
40
  Dim lngHariDay As Long
41
41
  Dim wshTenk As Worksheet
42
- Dim lngRowTenk As Long
42
+ Dim lngTenkRow As Long
43
- Dim lngRowTenkEnd As Long
43
+ Dim lngTenkRowEnd As Long
44
44
  Dim strTenk認定 As String
45
- Dim dctRow整理番号 As Dictionary
45
+ Dim dctTenk整理番号Row As Dictionary
46
46
  Dim wsh1gou As Worksheet
47
- Dim lngRow1gou As Long
47
+ Dim lng1gouRow As Long
48
- Dim str1gou児童名 As String
49
48
  Dim str1gou整理番号 As String
50
49
  Dim lng1gou朝夕区分 As Long
51
-
52
50
  Set wshHari = Worksheets("貼付用")
53
51
  Set wshTenk = Worksheets("転記")
54
52
  Set wsh1gou = Worksheets("1号")
55
- Set dctRow整理番号 = New Dictionary
53
+ Set dctTenk整理番号Row = New Dictionary
56
54
 
57
55
  '[貼付用]シートを[貼付用]の昇順、[降校時刻]の降順でソート
58
56
 
@@ -65,71 +63,73 @@
65
63
  .Apply
66
64
  End With
67
65
 
68
- '[転記]シートの[整理番号]の行番号を取得
66
+ '[転記]シートの[整理番号]の行番号をDictionaryに登録
69
67
 
70
- lngRowTenkEnd = wshTenk.Cells(wshTenk.Rows.Count, ColTenk整理番号).End(xlUp).Row
68
+ lngTenkRowEnd = wshTenk.Cells(wshTenk.Rows.Count, ColTenk整理番号).End(xlUp).Row
71
- For lngRowTenk = RowTenk明細 To lngRowTenkEnd
69
+ For lngTenkRow = RowTenk明細 To lngTenkRowEnd
72
- dctRow整理番号.Add wshTenk.Cells(lngRowTenk, ColTenk整理番号).Value, lngRowTenk
70
+ dctTenk整理番号Row.Add wshTenk.Cells(lngTenkRow, ColTenk整理番号).Value, lngTenkRow
73
- Next lngRowTenk
71
+ Next lngTenkRow
74
72
 
75
73
  '[1号]シートの更新
76
74
 
77
- lngRow1gou = Row1gou明細 - 1
75
+ lng1gouRow = Row1gou明細 - 1
78
- lngRowHariEnd = wshHari.Cells(wshHari.Rows.Count, ColHari出席番号).End(xlUp).Row
76
+ lngHariRowEnd = wshHari.Cells(wshHari.Rows.Count, ColHari出席番号).End(xlUp).Row
79
- For lngRowHari = RowHari明細 To lngRowHariEnd
77
+ For lngHariRow = RowHari明細 To lngHariRowEnd
78
+
79
+ '[転記]シートの[整理番号]の行番号を取得
80
+
80
- varHari出席番号 = wshHari.Cells(lngRowHari, ColHari出席番号).Value
81
+ varHari出席番号 = wshHari.Cells(lngHariRow, ColHari出席番号).Value
81
- If dctRow整理番号.Exists(varHari出席番号) = False Then
82
+ If dctTenk整理番号Row.Exists(varHari出席番号) = False Then
82
83
  MsgBox varHari出席番号 & "が存在しません。"
83
84
  GoTo s_set1gou_Exit
84
85
  End If
85
- lngRowTenk = dctRow整理番号.Item(varHari出席番号)
86
+ lngTenkRow = dctTenk整理番号Row.Item(varHari出席番号)
87
+
86
- strTenk認定 = wshTenk.Cells(lngRowTenk, ColTenk認定)
88
+ strTenk認定 = wshTenk.Cells(lngTenkRow, ColTenk認定)
87
- If (strTenk認定 = "新1号" Or strTenk認定 = "新2号" Or strTenk認定 = "新3号") And wshTenk.Cells(lngRowTenk, ColTenk在籍) = "有" Then
89
+ If (strTenk認定 = "新1号" Or strTenk認定 = "新2号" Or strTenk認定 = "新3号") And wshTenk.Cells(lngTenkRow, ColTenk在籍) = "有" Then
88
90
  '夕
89
- datHari降校時刻 = wshHari.Cells(lngRowHari, ColHari降校時刻).Value
91
+ datHari降校時刻 = wshHari.Cells(lngHariRow, ColHari降校時刻).Value
90
92
  If datHari降校時刻 >= TimeValue("15:30") Then
91
- lngHariDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
93
+ lngHariDay = Day(wshHari.Cells(lngHariRow, ColHari日付).Value)
92
- str1gou児童名 = wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value
93
94
  If str1gou整理番号 = varHari出席番号 Then
94
95
  If lng1gou朝夕区分 = 2 Then
95
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
96
+ wsh1gou.Cells(lng1gouRow, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
96
97
  Else
97
- wsh1gou.Cells(lngRow1gou - 1, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
98
+ wsh1gou.Cells(lng1gouRow - 1, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
98
99
  End If
99
100
  Else
100
- lngRow1gou = lngRow1gou + 1
101
+ lng1gouRow = lng1gouRow + 1
101
102
  str1gou整理番号 = varHari出席番号
102
103
  lng1gou朝夕区分 = 2
103
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
104
+ wsh1gou.Cells(lng1gouRow, Col1gou児童名).Value = wshTenk.Cells(lngTenkRow, ColTenk園児名).Value
104
- wsh1gou.Cells(lngRow1gou, Col1gou年齢).Value = wshTenk.Cells(lngRowTenk, ColTenk年齢).Value
105
+ wsh1gou.Cells(lng1gouRow, Col1gou年齢).Value = wshTenk.Cells(lngTenkRow, ColTenk年齢).Value
105
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
106
+ wsh1gou.Cells(lng1gouRow, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
106
- wsh1gou.Cells(lngRow1gou, Col1gou免除).Value = wshTenk.Cells(lngRowTenk, ColTenk免除).Value
107
+ wsh1gou.Cells(lng1gouRow, Col1gou免除).Value = wshTenk.Cells(lngTenkRow, ColTenk免除).Value
107
108
  End If
108
109
  End If
109
110
  '朝
110
- datHari登校時刻 = wshHari.Cells(lngRowHari, ColHari登校時刻).Value
111
+ datHari登校時刻 = wshHari.Cells(lngHariRow, ColHari登校時刻).Value
111
112
  If datHari登校時刻 < TimeValue("09:00") Then
112
- lngHariDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
113
+ lngHariDay = Day(wshHari.Cells(lngHariRow, ColHari日付).Value)
113
- str1gou児童名 = wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value
114
114
  If str1gou整理番号 = varHari出席番号 And lng1gou朝夕区分 = 1 Then
115
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari登校時刻, "hmm")
115
+ wsh1gou.Cells(lng1gouRow, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari登校時刻, "hmm")
116
116
  Else
117
- lngRow1gou = lngRow1gou + 1
117
+ lng1gouRow = lng1gouRow + 1
118
118
  str1gou整理番号 = varHari出席番号
119
119
  lng1gou朝夕区分 = 1
120
- wsh1gou.Cells(lngRow1gou, Col1gou時間帯).Value = 1
120
+ wsh1gou.Cells(lng1gouRow, Col1gou時間帯).Value = 1
121
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
121
+ wsh1gou.Cells(lng1gouRow, Col1gou児童名).Value = wshTenk.Cells(lngTenkRow, ColTenk園児名).Value
122
- wsh1gou.Cells(lngRow1gou, Col1gou年齢).Value = wshTenk.Cells(lngRowTenk, ColTenk年齢).Value
122
+ wsh1gou.Cells(lng1gouRow, Col1gou年齢).Value = wshTenk.Cells(lngTenkRow, ColTenk年齢).Value
123
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari登校時刻, "hmm")
123
+ wsh1gou.Cells(lng1gouRow, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari登校時刻, "hmm")
124
- wsh1gou.Cells(lngRow1gou, Col1gou免除).Value = wshTenk.Cells(lngRowTenk, ColTenk免除).Value
124
+ wsh1gou.Cells(lng1gouRow, Col1gou免除).Value = wshTenk.Cells(lngTenkRow, ColTenk免除).Value
125
125
  End If
126
126
  End If
127
127
  End If
128
- Next lngRowHari
128
+ Next lngHariRow
129
129
 
130
130
  s_set1gou_Exit:
131
131
 
132
- Set dctRow整理番号 = Nothing
132
+ Set dctTenk整理番号Row = Nothing
133
133
  Set wsh1gou = Nothing
134
134
  Set wshTenk = Nothing
135
135
  Set wshHari = Nothing

4

コード一部修正

2020/09/20 03:03

投稿

kitasue
kitasue

スコア314

answer CHANGED
@@ -30,24 +30,24 @@
30
30
  Const Col2gou免除 = "AS"
31
31
 
32
32
  Sub s_set1gou()
33
+
33
-
34
+ Dim wshHari As Worksheet
34
35
  Dim lngRowHari As Long
35
36
  Dim lngRowHariEnd As Long
37
+ Dim varHari出席番号 As Variant
38
+ Dim datHari登校時刻 As Date
39
+ Dim datHari降校時刻 As Date
40
+ Dim lngHariDay As Long
41
+ Dim wshTenk As Worksheet
36
42
  Dim lngRowTenk As Long
37
43
  Dim lngRowTenkEnd As Long
44
+ Dim strTenk認定 As String
45
+ Dim dctRow整理番号 As Dictionary
46
+ Dim wsh1gou As Worksheet
38
47
  Dim lngRow1gou As Long
39
- Dim lngRow1gouEnd As Long
40
- Dim str認定 As String
41
- Dim str児童名 As String
48
+ Dim str1gou児童名 As String
42
- Dim dat降校時刻 As Date
49
+ Dim str1gou整理番号 As String
43
- Dim dat登校時刻 As Date
44
- Dim lngDay As Long
50
+ Dim lng1gou朝夕区分 As Long
45
- Dim wshHari As Worksheet
46
- Dim wshTenk As Worksheet
47
- Dim wsh1gou As Worksheet
48
- Dim dctRow整理番号 As Dictionary
49
- Dim var整理番号 As Variant
50
- Dim var児童名 As Variant
51
51
 
52
52
  Set wshHari = Worksheets("貼付用")
53
53
  Set wshTenk = Worksheets("転記")
@@ -77,60 +77,56 @@
77
77
  lngRow1gou = Row1gou明細 - 1
78
78
  lngRowHariEnd = wshHari.Cells(wshHari.Rows.Count, ColHari出席番号).End(xlUp).Row
79
79
  For lngRowHari = RowHari明細 To lngRowHariEnd
80
- var整理番号 = wshHari.Cells(lngRowHari, ColHari出席番号).Value
80
+ varHari出席番号 = wshHari.Cells(lngRowHari, ColHari出席番号).Value
81
- If dctRow整理番号.Exists(var整理番号) = False Then
81
+ If dctRow整理番号.Exists(varHari出席番号) = False Then
82
- MsgBox var整理番号 & "が存在しません。"
82
+ MsgBox varHari出席番号 & "が存在しません。"
83
83
  GoTo s_set1gou_Exit
84
84
  End If
85
- lngRowTenk = dctRow整理番号.Item(var整理番号)
85
+ lngRowTenk = dctRow整理番号.Item(varHari出席番号)
86
- str認定 = wshTenk.Cells(lngRowTenk, ColTenk認定)
86
+ strTenk認定 = wshTenk.Cells(lngRowTenk, ColTenk認定)
87
- If (str認定 = "新1号" Or str認定 = "新2号" Or str認定 = "新3号") And wshTenk.Cells(lngRowTenk, ColTenk在籍) = "有" Then
87
+ If (strTenk認定 = "新1号" Or strTenk認定 = "新2号" Or strTenk認定 = "新3号") And wshTenk.Cells(lngRowTenk, ColTenk在籍) = "有" Then
88
88
  '夕
89
- dat降校時刻 = wshHari.Cells(lngRowHari, ColHari降校時刻).Value
89
+ datHari降校時刻 = wshHari.Cells(lngRowHari, ColHari降校時刻).Value
90
- If dat降校時刻 >= TimeValue("15:30") Then
90
+ If datHari降校時刻 >= TimeValue("15:30") Then
91
- lngDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
91
+ lngHariDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
92
- var児童名 = Split(wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value & vbTab & vbTab, vbTab)
93
- If var児童名(0) = CStr(wshHari.Cells(lngRowHari, ColHari出席番号).Value) Then
92
+ str1gou児童名 = wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value
94
- If var児童名(1) = "2" Then
93
+ If str1gou整理番号 = varHari出席番号 Then
94
+ If lng1gou朝夕区分 = 2 Then
95
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat降校時刻, "hmm")
95
+ wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
96
96
  Else
97
- wsh1gou.Cells(lngRow1gou - 1, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat降校時刻, "hmm")
97
+ wsh1gou.Cells(lngRow1gou - 1, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
98
98
  End If
99
99
  Else
100
100
  lngRow1gou = lngRow1gou + 1
101
+ str1gou整理番号 = varHari出席番号
102
+ lng1gou朝夕区分 = 2
101
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshHari.Cells(lngRowHari, ColHari出席番号).Value & vbTab & 2 & vbTab & wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
103
+ wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
102
104
  wsh1gou.Cells(lngRow1gou, Col1gou年齢).Value = wshTenk.Cells(lngRowTenk, ColTenk年齢).Value
103
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat降校時刻, "hmm")
105
+ wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari降校時刻, "hmm")
104
106
  wsh1gou.Cells(lngRow1gou, Col1gou免除).Value = wshTenk.Cells(lngRowTenk, ColTenk免除).Value
105
107
  End If
106
108
  End If
107
109
  '朝
108
- dat登校時刻 = wshHari.Cells(lngRowHari, ColHari登校時刻).Value
110
+ datHari登校時刻 = wshHari.Cells(lngRowHari, ColHari登校時刻).Value
109
- If dat登校時刻 < TimeValue("09:00") Then
111
+ If datHari登校時刻 < TimeValue("09:00") Then
110
- lngDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
112
+ lngHariDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
111
- var児童名 = Split(wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value & vbTab & vbTab, vbTab)
113
+ str1gou児童名 = wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value
112
- If var児童名(0) = CStr(wshHari.Cells(lngRowHari, ColHari出席番号).Value) And var児童名(1) = "1" Then
114
+ If str1gou整理番号 = varHari出席番号 And lng1gou朝夕区分 = 1 Then
113
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat登校時刻, "hmm")
115
+ wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari登校時刻, "hmm")
114
116
  Else
115
117
  lngRow1gou = lngRow1gou + 1
118
+ str1gou整理番号 = varHari出席番号
119
+ lng1gou朝夕区分 = 1
116
120
  wsh1gou.Cells(lngRow1gou, Col1gou時間帯).Value = 1
117
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshHari.Cells(lngRowHari, ColHari出席番号).Value & vbTab & 1 & vbTab & wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
121
+ wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
118
122
  wsh1gou.Cells(lngRow1gou, Col1gou年齢).Value = wshTenk.Cells(lngRowTenk, ColTenk年齢).Value
119
- wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat登校時刻, "hmm")
123
+ wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngHariDay - 1).Value = Format(datHari登校時刻, "hmm")
120
124
  wsh1gou.Cells(lngRow1gou, Col1gou免除).Value = wshTenk.Cells(lngRowTenk, ColTenk免除).Value
121
125
  End If
122
126
  End If
123
127
  End If
124
128
  Next lngRowHari
125
-
126
- '児童名の先頭に仮設定した整理番号と朝夕の区分を削除
129
+
127
-
128
- lngRow1gouEnd = wsh1gou.Cells(wsh1gou.Rows.Count, Col1gou児童名).End(xlUp).Row
129
- For lngRow1gou = Row1gou明細 To lngRow1gouEnd
130
- var児童名 = Split(wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value & vbTab & vbTab, vbTab)
131
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = var児童名(2)
132
- Next lngRow1gou
133
-
134
130
  s_set1gou_Exit:
135
131
 
136
132
  Set dctRow整理番号 = Nothing

3

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

2020/09/19 18:07

投稿

kitasue
kitasue

スコア314

answer CHANGED
@@ -47,6 +47,7 @@
47
47
  Dim wsh1gou As Worksheet
48
48
  Dim dctRow整理番号 As Dictionary
49
49
  Dim var整理番号 As Variant
50
+ Dim var児童名 As Variant
50
51
 
51
52
  Set wshHari = Worksheets("貼付用")
52
53
  Set wshTenk = Worksheets("転記")
@@ -88,16 +89,16 @@
88
89
  dat降校時刻 = wshHari.Cells(lngRowHari, ColHari降校時刻).Value
89
90
  If dat降校時刻 >= TimeValue("15:30") Then
90
91
  lngDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
91
- str児童名 = wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value
92
+ var児童名 = Split(wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value & vbTab & vbTab, vbTab)
92
- If Left(str児童名, 4) = CStr(wshHari.Cells(lngRowHari, ColHari出席番号).Value) Then
93
+ If var児童名(0) = CStr(wshHari.Cells(lngRowHari, ColHari出席番号).Value) Then
93
- If Mid(str児童名, 5, 1) = "2" Then
94
+ If var児童名(1) = "2" Then
94
95
  wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat降校時刻, "hmm")
95
96
  Else
96
97
  wsh1gou.Cells(lngRow1gou - 1, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat降校時刻, "hmm")
97
98
  End If
98
99
  Else
99
100
  lngRow1gou = lngRow1gou + 1
100
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshHari.Cells(lngRowHari, ColHari出席番号).Value & "2" & wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
101
+ wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshHari.Cells(lngRowHari, ColHari出席番号).Value & vbTab & 2 & vbTab & wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
101
102
  wsh1gou.Cells(lngRow1gou, Col1gou年齢).Value = wshTenk.Cells(lngRowTenk, ColTenk年齢).Value
102
103
  wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat降校時刻, "hmm")
103
104
  wsh1gou.Cells(lngRow1gou, Col1gou免除).Value = wshTenk.Cells(lngRowTenk, ColTenk免除).Value
@@ -107,13 +108,13 @@
107
108
  dat登校時刻 = wshHari.Cells(lngRowHari, ColHari登校時刻).Value
108
109
  If dat登校時刻 < TimeValue("09:00") Then
109
110
  lngDay = Day(wshHari.Cells(lngRowHari, ColHari日付).Value)
110
- str児童名 = wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value
111
+ var児童名 = Split(wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value & vbTab & vbTab, vbTab)
111
- If Left(str児童名, 5) = wshHari.Cells(lngRowHari, ColHari出席番号).Value & "1" Then
112
+ If var児童名(0) = CStr(wshHari.Cells(lngRowHari, ColHari出席番号).Value) And var児童名(1) = "1" Then
112
113
  wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat登校時刻, "hmm")
113
114
  Else
114
115
  lngRow1gou = lngRow1gou + 1
115
116
  wsh1gou.Cells(lngRow1gou, Col1gou時間帯).Value = 1
116
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshHari.Cells(lngRowHari, ColHari出席番号).Value & "1" & wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
117
+ wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = wshHari.Cells(lngRowHari, ColHari出席番号).Value & vbTab & 1 & vbTab & wshTenk.Cells(lngRowTenk, ColTenk園児名).Value
117
118
  wsh1gou.Cells(lngRow1gou, Col1gou年齢).Value = wshTenk.Cells(lngRowTenk, ColTenk年齢).Value
118
119
  wsh1gou.Cells(lngRow1gou, Col1gou1日).Offset(, lngDay - 1).Value = Format(dat登校時刻, "hmm")
119
120
  wsh1gou.Cells(lngRow1gou, Col1gou免除).Value = wshTenk.Cells(lngRowTenk, ColTenk免除).Value
@@ -122,12 +123,12 @@
122
123
  End If
123
124
  Next lngRowHari
124
125
 
125
- '児童名の先頭に仮設定した整理番号4桁と朝夕の区分1桁を削除
126
+ '児童名の先頭に仮設定した整理番号と朝夕の区分を削除
126
127
 
127
128
  lngRow1gouEnd = wsh1gou.Cells(wsh1gou.Rows.Count, Col1gou児童名).End(xlUp).Row
128
129
  For lngRow1gou = Row1gou明細 To lngRow1gouEnd
129
- str児童名 = wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value
130
+ var児童名 = Split(wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value & vbTab & vbTab, vbTab)
130
- wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = Mid(str児童名, 6)
131
+ wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = var児童名(2)
131
132
  Next lngRow1gou
132
133
 
133
134
  s_set1gou_Exit:

2

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

2020/09/19 08:53

投稿

kitasue
kitasue

スコア314

answer CHANGED
@@ -46,6 +46,7 @@
46
46
  Dim wshTenk As Worksheet
47
47
  Dim wsh1gou As Worksheet
48
48
  Dim dctRow整理番号 As Dictionary
49
+ Dim var整理番号 As Variant
49
50
 
50
51
  Set wshHari = Worksheets("貼付用")
51
52
  Set wshTenk = Worksheets("転記")
@@ -75,7 +76,12 @@
75
76
  lngRow1gou = Row1gou明細 - 1
76
77
  lngRowHariEnd = wshHari.Cells(wshHari.Rows.Count, ColHari出席番号).End(xlUp).Row
77
78
  For lngRowHari = RowHari明細 To lngRowHariEnd
78
- lngRowTenk = dctRow整理番号.Item(wshHari.Cells(lngRowHari, ColHari出席番号).Value)
79
+ var整理番号 = wshHari.Cells(lngRowHari, ColHari出席番号).Value
80
+ If dctRow整理番号.Exists(var整理番号) = False Then
81
+ MsgBox var整理番号 & "が存在しません。"
82
+ GoTo s_set1gou_Exit
83
+ End If
84
+ lngRowTenk = dctRow整理番号.Item(var整理番号)
79
85
  str認定 = wshTenk.Cells(lngRowTenk, ColTenk認定)
80
86
  If (str認定 = "新1号" Or str認定 = "新2号" Or str認定 = "新3号") And wshTenk.Cells(lngRowTenk, ColTenk在籍) = "有" Then
81
87
  '夕
@@ -124,6 +130,8 @@
124
130
  wsh1gou.Cells(lngRow1gou, Col1gou児童名).Value = Mid(str児童名, 6)
125
131
  Next lngRow1gou
126
132
 
133
+ s_set1gou_Exit:
134
+
127
135
  Set dctRow整理番号 = Nothing
128
136
  Set wsh1gou = Nothing
129
137
  Set wshTenk = Nothing

1

説明文の誤りを修正

2020/09/19 08:01

投稿

kitasue
kitasue

スコア314

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