teratail
回答率
85.35%
teratail header banner
teratail header banner
質問するログイン新規登録
トップVBAに関する質問VBAについて(同じ値でかつ4件までをコピーする方法)

編集履歴

回答編集履歴

6

こちらかがいいかも

2020/07/29 08:27

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1,4 +1,10 @@
1
1
  ~~コメント無駄なので削除します。~~
2
+
3
+
4
+
5
+ 私にはいいのですが、コードを
6
+
7
+ 試したのかどうか、コメントはした方がよろしいかと思います（皆さん必死に考えてくれていますので）。
2
8
 
3
9
 
4
10
 

5

こちらかがいいかも

2020/07/29 08:27

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1 +1,157 @@
1
- コメント無駄なので削除します。
1
+ ~~コメント無駄なので削除します。~~
2
+
3
+
4
+
5
+ dataシートを評価して、tenkiシートに展開するサンプルです。
6
+
7
+ 参考にならないと思いますが掲載しておきます。
8
+
9
+
10
+
11
+ ```VBA
12
+
13
+ Sub test()
14
+
15
+
16
+
17
+ Dim celno As Double
18
+
19
+ Dim num As Double
20
+
21
+
22
+
23
+ celno = 1
24
+
25
+
26
+
27
+ For i = 2 To 15
28
+
29
+
30
+
31
+ With Sheets("data")
32
+
33
+
34
+
35
+ 納入場所 = .Range("D" & i).Value
36
+
37
+
38
+
39
+ celno = celno + 1
40
+
41
+
42
+
43
+ If 納入場所 <> 前回納入場所 Then
44
+
45
+
46
+
47
+ num = 0
48
+
49
+
50
+
51
+ If i = 2 Then
52
+
53
+ Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
54
+
55
+ Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
56
+
57
+ Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
58
+
59
+ Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
60
+
61
+
62
+
63
+ ElseIf i <> 2 Then
64
+
65
+ celno = celno + 1
66
+
67
+
68
+
69
+ Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
70
+
71
+ Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
72
+
73
+ Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
74
+
75
+ Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
76
+
77
+
78
+
79
+ End If
80
+
81
+
82
+
83
+ End If
84
+
85
+
86
+
87
+
88
+
89
+ If 納入場所 = 前回納入場所 Then
90
+
91
+
92
+
93
+ num = num + 1
94
+
95
+
96
+
97
+ If num = 4 Then
98
+
99
+
100
+
101
+ celno = celno + 1
102
+
103
+
104
+
105
+ Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
106
+
107
+ Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
108
+
109
+ Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
110
+
111
+ Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
112
+
113
+
114
+
115
+ num = 0
116
+
117
+
118
+
119
+ Else
120
+
121
+ Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
122
+
123
+ Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
124
+
125
+ Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
126
+
127
+ Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
128
+
129
+
130
+
131
+ End If
132
+
133
+
134
+
135
+ End If
136
+
137
+
138
+
139
+
140
+
141
+
142
+
143
+ 前回納入場所 = 納入場所
144
+
145
+
146
+
147
+ End With
148
+
149
+
150
+
151
+ Next
152
+
153
+
154
+
155
+ End Sub
156
+
157
+ ```

4

削除

2020/07/29 08:25

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1,175 +1 @@
1
- 元シートをdata、転記先をtenkiとします。
2
-
3
- tenkiシートのA1～D1にはタイトル行があるものとします。
4
-
5
- 下記マクロを実行するとtenkiシートにブロックに分けて転写されると思います。
6
-
7
-
8
-
9
- celno = celno + 1という部分のカウンター変数を増やしたりすることで
10
-
11
- 転記場所を変動させています。
1
+ コメント無駄なので削除します。
12
-
13
-
14
-
15
- num変数で４件か否かをチェックし、納入場所が変わると初期化して0としています。
16
-
17
- もう少しきれいに書けるような気もしますが、サンプルということで・・・。
18
-
19
-
20
-
21
- ```VBA
22
-
23
- Sub test()
24
-
25
-
26
-
27
- Dim celno As Double
28
-
29
- Dim num As Double
30
-
31
- Dim i As Double
32
-
33
- Dim 納品場所 As string
34
-
35
- Dim 前回納品場所　As string
36
-
37
-
38
-
39
- celno = 1
40
-
41
-
42
-
43
- For i = 2 To 15 '最大データ数の取得は省略します（ベタな指定です）。
44
-
45
-
46
-
47
- With Sheets("data")
48
-
49
-
50
-
51
- 納入場所 = .Range("D" & i).Value
52
-
53
-
54
-
55
- celno = celno + 1
56
-
57
-
58
-
59
- If 納入場所 <> 前回納入場所 Then
60
-
61
-
62
-
63
- num = 0
64
-
65
-
66
-
67
- If i = 2 Then
68
-
69
- Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
70
-
71
- Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
72
-
73
- Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
74
-
75
- Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
76
-
77
-
78
-
79
- ElseIf i <> 2 Then
80
-
81
- celno = celno + 1
82
-
83
-
84
-
85
- Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
86
-
87
- Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
88
-
89
- Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
90
-
91
- Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
92
-
93
-
94
-
95
- End If
96
-
97
-
98
-
99
- End If
100
-
101
-
102
-
103
-
104
-
105
- If 納入場所 = 前回納入場所 Then
106
-
107
-
108
-
109
- num = num + 1
110
-
111
-
112
-
113
- If num = 4 Then
114
-
115
-
116
-
117
- celno = celno + 1
118
-
119
-
120
-
121
- Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
122
-
123
- Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
124
-
125
- Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
126
-
127
- Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
128
-
129
-
130
-
131
- num = 0
132
-
133
-
134
-
135
- Else
136
-
137
- Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
138
-
139
- Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
140
-
141
- Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
142
-
143
- Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
144
-
145
-
146
-
147
- End If
148
-
149
-
150
-
151
- End If
152
-
153
-
154
-
155
-
156
-
157
-
158
-
159
- 前回納入場所 = 納入場所
160
-
161
-
162
-
163
- End With
164
-
165
-
166
-
167
- Next
168
-
169
-
170
-
171
- End Sub
172
-
173
-
174
-
175
- ```

3

こちらかがいいかも

2020/07/28 23:37

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -1,6 +1,8 @@
1
- 元シートをdata、転記先をtenkiとします。tenkiシートのA1～D1にはタイトル行があるものとします。
1
+ 元シートをdata、転記先をtenkiとします。
2
2
 
3
+ tenkiシートのA1～D1にはタイトル行があるものとします。
4
+
3
- 下記マクロを実行するとブロックに分けて転写されると思います。
5
+ 下記マクロを実行するとtenkiシートにブロックに分けて転写されると思います。
4
6
 
5
7
 
6
8
 
@@ -10,7 +12,7 @@
10
12
 
11
13
 
12
14
 
13
- num変数で４件か否かをチェックし、納入場所が変わると初期化して０としています。
15
+ num変数で４件か否かをチェックし、納入場所が変わると初期化して0としています。
14
16
 
15
17
  もう少しきれいに書けるような気もしますが、サンプルということで・・・。
16
18
 
@@ -26,11 +28,11 @@
26
28
 
27
29
  Dim num As Double
28
30
 
29
- dim i as Double
31
+ Dim i As Double
30
32
 
31
- dim 納品場所 As string
33
+ Dim 納品場所 As string
32
34
 
33
- dim 前回納品場所　As string
35
+ Dim 前回納品場所　As string
34
36
 
35
37
 
36
38
 

2

こちらかがいいかも

2020/07/28 00:44

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -28,13 +28,17 @@
28
28
 
29
29
  dim i as Double
30
30
 
31
+ dim 納品場所 As string
32
+
33
+ dim 前回納品場所　As string
34
+
31
35
 
32
36
 
33
37
  celno = 1
34
38
 
35
39
 
36
40
 
37
- For i = 2 To 15
41
+ For i = 2 To 15 '最大データ数の取得は省略します（ベタな指定です）。
38
42
 
39
43
 
40
44
 

1

こちらかがいいかも

2020/07/28 00:36

投稿

mako1972
mako1972

スコア383

test CHANGED
@@ -26,13 +26,15 @@
26
26
 
27
27
  Dim num As Double
28
28
 
29
+ dim i as Double
30
+
29
31
 
30
32
 
31
33
  celno = 1
32
34
 
33
35
 
34
36
 
35
- For i = 2 To 15
37
+ For i = 2 To 15
36
38
 
37
39
 
38
40