回答編集履歴

8

こちらかがいいかも

2020/08/13 10:59

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1,5 +1,9 @@
1
1
  レスがつかないようなので再UPします。
2
2
 
3
+ 仕様書が意味があるのか、理解に苦しむところでレスがつかないものと思われます。
4
+
5
+ また、解釈が違うようでしたらスルーして結構です。
6
+
3
7
 
4
8
 
5
9
  [データ便:2日間以内にダウンロード](https://www.datadeliver.net/download_url.do?fb=be9ee071e8034b27ae20f5b5bc3b23b0&se=d5bc4a1b332d4e92bf98e959512f731f)

7

こちらかがいいかも

2020/08/13 10:59

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -24,8 +24,210 @@
24
24
 
25
25
  注意点として、当期シートの見出しがグループ化されていることでソートがうまくいかないため
26
26
 
27
- 結合を解除していることに注意してください。
27
+ タイトル行の結合を解除していることに注意してください。
28
28
 
29
29
 
30
30
 
31
31
  以上 よろしくお願いいたします。
32
+
33
+
34
+
35
+ ```VBA
36
+
37
+ Sub Macro1()
38
+
39
+
40
+
41
+ Dim ws1 As Worksheet
42
+
43
+ Dim ws2 As Worksheet
44
+
45
+ Dim maxrow1 As Double
46
+
47
+ Dim maxrow2 As Double
48
+
49
+
50
+
51
+ Dim namecode As Integer
52
+
53
+ Dim i As Double
54
+
55
+ Dim sortmaxrow As Double
56
+
57
+
58
+
59
+
60
+
61
+ Set ws1 = Worksheets("仕様書")
62
+
63
+ Set ws2 = Worksheets("当期")
64
+
65
+
66
+
67
+ maxrow1 = ws1.Cells(Rows.Count, "K").End(xlUp).Row '仕様書シートのデータ数を取得
68
+
69
+ maxrow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row '当期シートのデータ数を取得
70
+
71
+
72
+
73
+ '■Q1
74
+
75
+
76
+
77
+ If ws1.Range("H23").Value = "1Q" Then
78
+
79
+ ws2.Range("A23:i" & maxrow1 + 1).Value = ws1.Range("K22:S" & maxrow1).Value
80
+
81
+ MsgBox "1Qのデータをコピーしました!"
82
+
83
+ End If
84
+
85
+
86
+
87
+
88
+
89
+
90
+
91
+ '■Q2
92
+
93
+ If ws1.Range("H23").Value = "2Q" Then
94
+
95
+
96
+
97
+ For i = 22 To maxrow1
98
+
99
+
100
+
101
+ namecode = ws1.Range("M" & i).Value
102
+
103
+
104
+
105
+ namecode_cnt = WorksheetFunction.CountIf(ws2.Range("C23:C" & maxrow2), namecode)
106
+
107
+
108
+
109
+ If namecode_cnt = 0 Then
110
+
111
+
112
+
113
+ maxrow2 = maxrow2 + 1
114
+
115
+
116
+
117
+ ws2.Range("A" & maxrow2).Value = ws1.Range("K" & i).Value
118
+
119
+ ws2.Range("B" & maxrow2).Value = ws1.Range("L" & i).Value
120
+
121
+ ws2.Range("C" & maxrow2).Value = ws1.Range("M" & i).Value
122
+
123
+ ws2.Range("D" & maxrow2).Value = ws1.Range("N" & i).Value
124
+
125
+
126
+
127
+ ws2.Range("J" & maxrow2).Value = ws1.Range("O" & i).Value
128
+
129
+ ws2.Range("K" & maxrow2).Value = ws1.Range("P" & i).Value
130
+
131
+ ws2.Range("L" & maxrow2).Value = ws1.Range("Q" & i).Value
132
+
133
+ ws2.Range("M" & maxrow2).Value = ws1.Range("R" & i).Value
134
+
135
+ ws2.Range("N" & maxrow2).Value = ws1.Range("S" & i).Value
136
+
137
+
138
+
139
+ End If
140
+
141
+
142
+
143
+
144
+
145
+ If namecode_cnt = 1 Then
146
+
147
+
148
+
149
+ cellno = WorksheetFunction.Match(namecode, ws2.Range("C23:C" & maxrow2), 0)
150
+
151
+
152
+
153
+ ws2.Range("J" & cellno + 22).Value = ws1.Range("O" & i).Value
154
+
155
+ ws2.Range("K" & cellno + 22).Value = ws1.Range("P" & i).Value
156
+
157
+ ws2.Range("L" & cellno + 22).Value = ws1.Range("Q" & i).Value
158
+
159
+ ws2.Range("M" & cellno + 22).Value = ws1.Range("R" & i).Value
160
+
161
+ ws2.Range("N" & cellno + 22).Value = ws1.Range("S" & i).Value
162
+
163
+
164
+
165
+
166
+
167
+ End If
168
+
169
+
170
+
171
+ Next
172
+
173
+
174
+
175
+ sortmaxrow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
176
+
177
+
178
+
179
+ Call mysort(sortmaxrow)
180
+
181
+
182
+
183
+
184
+
185
+ MsgBox "データをQ2に転記し、データをソートしました!"
186
+
187
+
188
+
189
+ End If
190
+
191
+
192
+
193
+ Set ws1 = Nothing
194
+
195
+ Set ws2 = Nothing
196
+
197
+
198
+
199
+
200
+
201
+ End Sub
202
+
203
+
204
+
205
+ Sub mysort(sortmaxrow As Double)
206
+
207
+
208
+
209
+ With Sheets("当期")
210
+
211
+ .Sort.SortFields.Clear
212
+
213
+ .Range("A22:S" & sortmaxrow).Sort _
214
+
215
+ Key1:=.Range("A23"), Order1:=xlAscending, _
216
+
217
+ Key2:=.Range("C23"), Order2:=xlAscending, _
218
+
219
+ Header:=xlYes
220
+
221
+
222
+
223
+ End With
224
+
225
+
226
+
227
+ End Sub
228
+
229
+
230
+
231
+
232
+
233
+ ```

6

こちらかがいいかも

2020/08/13 10:57

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1 +1,31 @@
1
- 無駄回答と判断しましたので削除します。
1
+ レスがつかいようなので再UPします。
2
+
3
+
4
+
5
+ [データ便:2日間以内にダウンロード](https://www.datadeliver.net/download_url.do?fb=be9ee071e8034b27ae20f5b5bc3b23b0&se=d5bc4a1b332d4e92bf98e959512f731f)
6
+
7
+
8
+
9
+
10
+
11
+ 検証データQ1、検証データQ2のデータをコピーして検証をお願いします。
12
+
13
+
14
+
15
+ あらかじめ、当期シートに検証用データQ1のデータを貼り付けてあります。
16
+
17
+ 仕様書シートに検証用データQ2を貼り付けてあります。
18
+
19
+
20
+
21
+ 仕様書シートの対象期間をQ2にして実行ボタンをクリックするとマクロを実行できます。
22
+
23
+
24
+
25
+ 注意点として、当期シートの見出しがグループ化されていることでソートがうまくいかないため
26
+
27
+ 結合を解除していることに注意してください。
28
+
29
+
30
+
31
+ 以上 よろしくお願いいたします。

5

削除

2020/08/13 10:49

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1,245 +1 @@
1
- サンプルをデータ便にUPしておきました。ダウンロード期間は2日間です。
2
-
3
-
4
-
5
- [データ便](https://www.datadeliver.net/receiver/file_box.do?fb=e831b6fa1c0741d1b0de652fd1450e1a&rc=ad401ee0d48c4140bf63c2e9c9e10c7e&lang=ja)
6
-
7
-
8
-
9
- サンプルですが、今回は配列を使わず、ワークシート関数を使用し、判定を行っています。
10
-
11
- 配列を使った方法もご検討いただけると良いかと思います(今回は直感的に理解できるよう配慮したつもりです)。
12
-
13
-
14
-
15
- 使用方法は、
16
-
17
- 1、仕様書データの対象期間:H23セルを1Q(半角で)として検証データQ1シートのデータを貼り付けて実行ボタンをクリック
18
-
19
- →当期シートにデータが転記される
20
-
21
-
22
-
23
- 2、仕様書データの対象期間:H23セルを2Q(半角で)として検証データQ2シートのデータを貼り付けて実行ボタンをクリック
24
-
25
- →結果がQ2の欄に転記され、区分コード、氏名コードでSortされる
26
-
27
-
28
-
29
- 以上
30
-
31
-
32
-
33
- ※注意)
34
-
35
-  当期シートのタイトル行が結合されていることにより、ソートできなかったため、
36
-
37
- 結合を外ておりす。ご了承ほどお願いいたします。
1
+ 無駄な回答と判断しましたで削除します。
38
-
39
-
40
-
41
- 主なVBAコードを記載しておきます。あくまでもサンプルということで了承ください。
42
-
43
-
44
-
45
- ```VBA
46
-
47
- Sub Macro1()
48
-
49
-
50
-
51
- Dim ws1 As Worksheet
52
-
53
- Dim ws2 As Worksheet
54
-
55
- Dim maxrow1 As Double
56
-
57
- Dim maxrow2 As Double
58
-
59
-
60
-
61
- Dim namecode As Integer
62
-
63
- Dim i As Double
64
-
65
- Dim sortmaxrow As Double
66
-
67
-
68
-
69
-
70
-
71
- Set ws1 = Worksheets("仕様書")
72
-
73
- Set ws2 = Worksheets("当期")
74
-
75
-
76
-
77
- maxrow1 = ws1.Cells(Rows.Count, "K").End(xlUp).Row '仕様書シートのデータ数を取得
78
-
79
- maxrow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row '当期シートのデータ数を取得
80
-
81
-
82
-
83
- '■Q1
84
-
85
-
86
-
87
- If ws1.Range("H23").Value = "1Q" Then
88
-
89
- ws2.Range("A23:i" & maxrow1 + 1).Value = ws1.Range("K22:S" & maxrow1).Value
90
-
91
- MsgBox "1Qのデータをコピーしました!"
92
-
93
- End If
94
-
95
-
96
-
97
-
98
-
99
-
100
-
101
- '■Q2
102
-
103
- If ws1.Range("H23").Value = "2Q" Then
104
-
105
-
106
-
107
- For i = 22 To maxrow1
108
-
109
-
110
-
111
- namecode = ws1.Range("M" & i).Value
112
-
113
-
114
-
115
- namecode_cnt = WorksheetFunction.CountIf(ws2.Range("C23:C" & maxrow2), namecode)
116
-
117
-
118
-
119
- If namecode_cnt = 0 Then
120
-
121
-
122
-
123
- maxrow2 = maxrow2 + 1
124
-
125
-
126
-
127
- ws2.Range("A" & maxrow2).Value = ws1.Range("K" & i).Value
128
-
129
- ws2.Range("B" & maxrow2).Value = ws1.Range("L" & i).Value
130
-
131
- ws2.Range("C" & maxrow2).Value = ws1.Range("M" & i).Value
132
-
133
- ws2.Range("D" & maxrow2).Value = ws1.Range("N" & i).Value
134
-
135
-
136
-
137
- ws2.Range("J" & maxrow2).Value = ws1.Range("O" & i).Value
138
-
139
- ws2.Range("K" & maxrow2).Value = ws1.Range("P" & i).Value
140
-
141
- ws2.Range("L" & maxrow2).Value = ws1.Range("Q" & i).Value
142
-
143
- ws2.Range("M" & maxrow2).Value = ws1.Range("R" & i).Value
144
-
145
- ws2.Range("N" & maxrow2).Value = ws1.Range("S" & i).Value
146
-
147
-
148
-
149
- End If
150
-
151
-
152
-
153
-
154
-
155
- If namecode_cnt = 1 Then
156
-
157
-
158
-
159
- cellno = WorksheetFunction.Match(namecode, ws2.Range("C23:C" & maxrow2), 0)
160
-
161
-
162
-
163
- ws2.Range("J" & cellno + 22).Value = ws1.Range("O" & i).Value
164
-
165
- ws2.Range("K" & cellno + 22).Value = ws1.Range("P" & i).Value
166
-
167
- ws2.Range("L" & cellno + 22).Value = ws1.Range("Q" & i).Value
168
-
169
- ws2.Range("M" & cellno + 22).Value = ws1.Range("R" & i).Value
170
-
171
- ws2.Range("N" & cellno + 22).Value = ws1.Range("S" & i).Value
172
-
173
-
174
-
175
-
176
-
177
- End If
178
-
179
-
180
-
181
- Next
182
-
183
-
184
-
185
- sortmaxrow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
186
-
187
-
188
-
189
- Call mysort(sortmaxrow)
190
-
191
-
192
-
193
-
194
-
195
- MsgBox "データをQ2に転記し、データをソートしました!"
196
-
197
-
198
-
199
- End If
200
-
201
-
202
-
203
-
204
-
205
- End Sub
206
-
207
-
208
-
209
- Sub mysort(sortmaxrow As Double)
210
-
211
-
212
-
213
- With Sheets("当期")
214
-
215
- .Sort.SortFields.Clear
216
-
217
- .Range("A22:S" & sortmaxrow).Sort _
218
-
219
- Key1:=.Range("A23"), Order1:=xlAscending, _
220
-
221
- Key2:=.Range("C23"), Order2:=xlAscending, _
222
-
223
- Header:=xlYes
224
-
225
-
226
-
227
- End With
228
-
229
- end sub
230
-
231
-
232
-
233
- Set ws1 = nothing
234
-
235
- Set ws2 = nothing
236
-
237
- End Sub
238
-
239
-
240
-
241
-
242
-
243
-
244
-
245
- ```

4

こちらかがいいかも

2020/08/11 03:17

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -6,6 +6,12 @@
6
6
 
7
7
 
8
8
 
9
+ サンプルですが、今回は配列を使わず、ワークシート関数を使用し、判定を行っています。
10
+
11
+ 配列を使った方法もご検討いただけると良いかと思います(今回は直感的に理解できるよう配慮したつもりです)。
12
+
13
+
14
+
9
15
  使用方法は、
10
16
 
11
17
  1、仕様書データの対象期間:H23セルを1Q(半角で)として検証データQ1シートのデータを貼り付けて実行ボタンをクリック

3

こちらかがいいかも

2020/08/08 00:58

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -24,6 +24,14 @@
24
24
 
25
25
 
26
26
 
27
+ ※注意)
28
+
29
+  当期シートのタイトル行が結合されていることにより、ソートできなかったため、
30
+
31
+ 結合を外しております。ご了承のほどお願いいたします。
32
+
33
+
34
+
27
35
  主なVBAコードを記載しておきます。あくまでもサンプルということで了承ください。
28
36
 
29
37
 

2

こちらかがいいかも

2020/08/08 00:50

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -8,13 +8,13 @@
8
8
 
9
9
  使用方法は、
10
10
 
11
- 1、仕様書データの対象期間:H23セルを1Qとして検証データQ1シートのデータを貼り付けて実行ボタンをクリック
11
+ 1、仕様書データの対象期間:H23セルを1Q(半角で)として検証データQ1シートのデータを貼り付けて実行ボタンをクリック
12
12
 
13
13
  →当期シートにデータが転記される
14
14
 
15
15
 
16
16
 
17
- 2、仕様書データの対象期間:H23セルを2Qとして検証データQ2シートのデータを貼り付けて実行ボタンをクリック
17
+ 2、仕様書データの対象期間:H23セルを2Q(半角で)として検証データQ2シートのデータを貼り付けて実行ボタンをクリック
18
18
 
19
19
  →結果がQ2の欄に転記され、区分コード、氏名コードでSortされる
20
20
 
@@ -212,6 +212,8 @@
212
212
 
213
213
  End With
214
214
 
215
+ end sub
216
+
215
217
 
216
218
 
217
219
  Set ws1 = nothing

1

こちらかがいいかも

2020/08/08 00:48

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -214,6 +214,10 @@
214
214
 
215
215
 
216
216
 
217
+ Set ws1 = nothing
218
+
219
+ Set ws2 = nothing
220
+
217
221
  End Sub
218
222
 
219
223