teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

8

こちらかがいいかも

2020/08/13 10:59

投稿

mako1972
mako1972

スコア383

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

7

こちらかがいいかも

2020/08/13 10:59

投稿

mako1972
mako1972

スコア383

answer CHANGED
@@ -11,6 +11,107 @@
11
11
  仕様書シートの対象期間をQ2にして実行ボタンをクリックするとマクロを実行できます。
12
12
 
13
13
  注意点として、当期シートの見出しがグループ化されていることでソートがうまくいかないため
14
- 結合を解除していることに注意してください。
14
+ タイトル行の結合を解除していることに注意してください。
15
15
 
16
- 以上 よろしくお願いいたします。
16
+ 以上 よろしくお願いいたします。
17
+
18
+ ```VBA
19
+ Sub Macro1()
20
+
21
+ Dim ws1 As Worksheet
22
+ Dim ws2 As Worksheet
23
+ Dim maxrow1 As Double
24
+ Dim maxrow2 As Double
25
+
26
+ Dim namecode As Integer
27
+ Dim i As Double
28
+ Dim sortmaxrow As Double
29
+
30
+
31
+ Set ws1 = Worksheets("仕様書")
32
+ Set ws2 = Worksheets("当期")
33
+
34
+ maxrow1 = ws1.Cells(Rows.Count, "K").End(xlUp).Row '仕様書シートのデータ数を取得
35
+ maxrow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row '当期シートのデータ数を取得
36
+
37
+ '■Q1
38
+
39
+ If ws1.Range("H23").Value = "1Q" Then
40
+ ws2.Range("A23:i" & maxrow1 + 1).Value = ws1.Range("K22:S" & maxrow1).Value
41
+ MsgBox "1Qのデータをコピーしました!"
42
+ End If
43
+
44
+
45
+
46
+ '■Q2
47
+ If ws1.Range("H23").Value = "2Q" Then
48
+
49
+ For i = 22 To maxrow1
50
+
51
+ namecode = ws1.Range("M" & i).Value
52
+
53
+ namecode_cnt = WorksheetFunction.CountIf(ws2.Range("C23:C" & maxrow2), namecode)
54
+
55
+ If namecode_cnt = 0 Then
56
+
57
+ maxrow2 = maxrow2 + 1
58
+
59
+ ws2.Range("A" & maxrow2).Value = ws1.Range("K" & i).Value
60
+ ws2.Range("B" & maxrow2).Value = ws1.Range("L" & i).Value
61
+ ws2.Range("C" & maxrow2).Value = ws1.Range("M" & i).Value
62
+ ws2.Range("D" & maxrow2).Value = ws1.Range("N" & i).Value
63
+
64
+ ws2.Range("J" & maxrow2).Value = ws1.Range("O" & i).Value
65
+ ws2.Range("K" & maxrow2).Value = ws1.Range("P" & i).Value
66
+ ws2.Range("L" & maxrow2).Value = ws1.Range("Q" & i).Value
67
+ ws2.Range("M" & maxrow2).Value = ws1.Range("R" & i).Value
68
+ ws2.Range("N" & maxrow2).Value = ws1.Range("S" & i).Value
69
+
70
+ End If
71
+
72
+
73
+ If namecode_cnt = 1 Then
74
+
75
+ cellno = WorksheetFunction.Match(namecode, ws2.Range("C23:C" & maxrow2), 0)
76
+
77
+ ws2.Range("J" & cellno + 22).Value = ws1.Range("O" & i).Value
78
+ ws2.Range("K" & cellno + 22).Value = ws1.Range("P" & i).Value
79
+ ws2.Range("L" & cellno + 22).Value = ws1.Range("Q" & i).Value
80
+ ws2.Range("M" & cellno + 22).Value = ws1.Range("R" & i).Value
81
+ ws2.Range("N" & cellno + 22).Value = ws1.Range("S" & i).Value
82
+
83
+
84
+ End If
85
+
86
+ Next
87
+
88
+ sortmaxrow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
89
+
90
+ Call mysort(sortmaxrow)
91
+
92
+
93
+ MsgBox "データをQ2に転記し、データをソートしました!"
94
+
95
+ End If
96
+
97
+ Set ws1 = Nothing
98
+ Set ws2 = Nothing
99
+
100
+
101
+ End Sub
102
+
103
+ Sub mysort(sortmaxrow As Double)
104
+
105
+ With Sheets("当期")
106
+ .Sort.SortFields.Clear
107
+ .Range("A22:S" & sortmaxrow).Sort _
108
+ Key1:=.Range("A23"), Order1:=xlAscending, _
109
+ Key2:=.Range("C23"), Order2:=xlAscending, _
110
+ Header:=xlYes
111
+
112
+ End With
113
+
114
+ End Sub
115
+
116
+
117
+ ```

6

こちらかがいいかも

2020/08/13 10:57

投稿

mako1972
mako1972

スコア383

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

5

削除

2020/08/13 10:49

投稿

mako1972
mako1972

スコア383

answer CHANGED
@@ -1,123 +1,1 @@
1
- サンプルをデータ便にUPしておきました。ダウンロード期間は2日間です。
2
-
3
- [データ便](https://www.datadeliver.net/receiver/file_box.do?fb=e831b6fa1c0741d1b0de652fd1450e1a&rc=ad401ee0d48c4140bf63c2e9c9e10c7e&lang=ja)
4
-
5
- サンプルですが、今回は配列を使わず、ワークシート関数を使用し、判定を行っています。
6
- 配列を使った方法もご検討いただけると良いかと思います(今回は直感的に理解できるよう配慮したつもりです)。
7
-
8
- 使用方法は、
9
- 1、仕様書データの対象期間:H23セルを1Q(半角で)として検証データQ1シートのデータを貼り付けて実行ボタンをクリック
10
- →当期シートにデータが転記される
11
-
12
- 2、仕様書データの対象期間:H23セルを2Q(半角で)として検証データQ2シートのデータを貼り付けて実行ボタンをクリック
13
- →結果がQ2の欄に転記され、区分コード、氏名コードでSortされる
14
-
15
- 以上
16
-
17
- ※注意)
18
-  当期シートのタイトル行が結合されていることにより、ソートできなかったため、
19
- 結合を外ておりす。ご了承のほどお願いいたします。
1
+ 無駄な回答と判断しまので削除します。
20
-
21
- 主なVBAコードを記載しておきます。あくまでもサンプルということで了承ください。
22
-
23
- ```VBA
24
- Sub Macro1()
25
-
26
- Dim ws1 As Worksheet
27
- Dim ws2 As Worksheet
28
- Dim maxrow1 As Double
29
- Dim maxrow2 As Double
30
-
31
- Dim namecode As Integer
32
- Dim i As Double
33
- Dim sortmaxrow As Double
34
-
35
-
36
- Set ws1 = Worksheets("仕様書")
37
- Set ws2 = Worksheets("当期")
38
-
39
- maxrow1 = ws1.Cells(Rows.Count, "K").End(xlUp).Row '仕様書シートのデータ数を取得
40
- maxrow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row '当期シートのデータ数を取得
41
-
42
- '■Q1
43
-
44
- If ws1.Range("H23").Value = "1Q" Then
45
- ws2.Range("A23:i" & maxrow1 + 1).Value = ws1.Range("K22:S" & maxrow1).Value
46
- MsgBox "1Qのデータをコピーしました!"
47
- End If
48
-
49
-
50
-
51
- '■Q2
52
- If ws1.Range("H23").Value = "2Q" Then
53
-
54
- For i = 22 To maxrow1
55
-
56
- namecode = ws1.Range("M" & i).Value
57
-
58
- namecode_cnt = WorksheetFunction.CountIf(ws2.Range("C23:C" & maxrow2), namecode)
59
-
60
- If namecode_cnt = 0 Then
61
-
62
- maxrow2 = maxrow2 + 1
63
-
64
- ws2.Range("A" & maxrow2).Value = ws1.Range("K" & i).Value
65
- ws2.Range("B" & maxrow2).Value = ws1.Range("L" & i).Value
66
- ws2.Range("C" & maxrow2).Value = ws1.Range("M" & i).Value
67
- ws2.Range("D" & maxrow2).Value = ws1.Range("N" & i).Value
68
-
69
- ws2.Range("J" & maxrow2).Value = ws1.Range("O" & i).Value
70
- ws2.Range("K" & maxrow2).Value = ws1.Range("P" & i).Value
71
- ws2.Range("L" & maxrow2).Value = ws1.Range("Q" & i).Value
72
- ws2.Range("M" & maxrow2).Value = ws1.Range("R" & i).Value
73
- ws2.Range("N" & maxrow2).Value = ws1.Range("S" & i).Value
74
-
75
- End If
76
-
77
-
78
- If namecode_cnt = 1 Then
79
-
80
- cellno = WorksheetFunction.Match(namecode, ws2.Range("C23:C" & maxrow2), 0)
81
-
82
- ws2.Range("J" & cellno + 22).Value = ws1.Range("O" & i).Value
83
- ws2.Range("K" & cellno + 22).Value = ws1.Range("P" & i).Value
84
- ws2.Range("L" & cellno + 22).Value = ws1.Range("Q" & i).Value
85
- ws2.Range("M" & cellno + 22).Value = ws1.Range("R" & i).Value
86
- ws2.Range("N" & cellno + 22).Value = ws1.Range("S" & i).Value
87
-
88
-
89
- End If
90
-
91
- Next
92
-
93
- sortmaxrow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
94
-
95
- Call mysort(sortmaxrow)
96
-
97
-
98
- MsgBox "データをQ2に転記し、データをソートしました!"
99
-
100
- End If
101
-
102
-
103
- End Sub
104
-
105
- Sub mysort(sortmaxrow As Double)
106
-
107
- With Sheets("当期")
108
- .Sort.SortFields.Clear
109
- .Range("A22:S" & sortmaxrow).Sort _
110
- Key1:=.Range("A23"), Order1:=xlAscending, _
111
- Key2:=.Range("C23"), Order2:=xlAscending, _
112
- Header:=xlYes
113
-
114
- End With
115
- end sub
116
-
117
- Set ws1 = nothing
118
- Set ws2 = nothing
119
- End Sub
120
-
121
-
122
-
123
- ```

4

こちらかがいいかも

2020/08/11 03:17

投稿

mako1972
mako1972

スコア383

answer CHANGED
@@ -2,6 +2,9 @@
2
2
 
3
3
  [データ便](https://www.datadeliver.net/receiver/file_box.do?fb=e831b6fa1c0741d1b0de652fd1450e1a&rc=ad401ee0d48c4140bf63c2e9c9e10c7e&lang=ja)
4
4
 
5
+ サンプルですが、今回は配列を使わず、ワークシート関数を使用し、判定を行っています。
6
+ 配列を使った方法もご検討いただけると良いかと思います(今回は直感的に理解できるよう配慮したつもりです)。
7
+
5
8
  使用方法は、
6
9
  1、仕様書データの対象期間:H23セルを1Q(半角で)として検証データQ1シートのデータを貼り付けて実行ボタンをクリック
7
10
  →当期シートにデータが転記される

3

こちらかがいいかも

2020/08/08 00:58

投稿

mako1972
mako1972

スコア383

answer CHANGED
@@ -11,6 +11,10 @@
11
11
 
12
12
  以上
13
13
 
14
+ ※注意)
15
+  当期シートのタイトル行が結合されていることにより、ソートできなかったため、
16
+ 結合を外しております。ご了承のほどお願いいたします。
17
+
14
18
  主なVBAコードを記載しておきます。あくまでもサンプルということで了承ください。
15
19
 
16
20
  ```VBA

2

こちらかがいいかも

2020/08/08 00:50

投稿

mako1972
mako1972

スコア383

answer CHANGED
@@ -3,10 +3,10 @@
3
3
  [データ便](https://www.datadeliver.net/receiver/file_box.do?fb=e831b6fa1c0741d1b0de652fd1450e1a&rc=ad401ee0d48c4140bf63c2e9c9e10c7e&lang=ja)
4
4
 
5
5
  使用方法は、
6
- 1、仕様書データの対象期間:H23セルを1Qとして検証データQ1シートのデータを貼り付けて実行ボタンをクリック
6
+ 1、仕様書データの対象期間:H23セルを1Q(半角で)として検証データQ1シートのデータを貼り付けて実行ボタンをクリック
7
7
  →当期シートにデータが転記される
8
8
 
9
- 2、仕様書データの対象期間:H23セルを2Qとして検証データQ2シートのデータを貼り付けて実行ボタンをクリック
9
+ 2、仕様書データの対象期間:H23セルを2Q(半角で)として検証データQ2シートのデータを貼り付けて実行ボタンをクリック
10
10
  →結果がQ2の欄に転記され、区分コード、氏名コードでSortされる
11
11
 
12
12
  以上
@@ -105,6 +105,7 @@
105
105
  Header:=xlYes
106
106
 
107
107
  End With
108
+ end sub
108
109
 
109
110
  Set ws1 = nothing
110
111
  Set ws2 = nothing

1

こちらかがいいかも

2020/08/08 00:48

投稿

mako1972
mako1972

スコア383

answer CHANGED
@@ -106,6 +106,8 @@
106
106
 
107
107
  End With
108
108
 
109
+ Set ws1 = nothing
110
+ Set ws2 = nothing
109
111
  End Sub
110
112
 
111
113