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

編集履歴

回答編集履歴

6

こちらかがいいかも

2020/07/29 08:27

投稿

mako1972
mako1972

スコア383

answer CHANGED
@@ -1,5 +1,8 @@
1
1
  ~~コメント無駄なので削除します。~~
2
2
 
3
+ 私にはいいのですが、コードを
4
+ 試したのかどうか、コメントはした方がよろしいかと思います（皆さん必死に考えてくれていますので）。
5
+
3
6
  dataシートを評価して、tenkiシートに展開するサンプルです。
4
7
  参考にならないと思いますが掲載しておきます。
5
8
 

5

こちらかがいいかも

2020/07/29 08:27

投稿

mako1972
mako1972

スコア383

answer CHANGED
@@ -1,1 +1,79 @@
1
- コメント無駄なので削除します。
1
+ ~~コメント無駄なので削除します。~~
2
+
3
+ dataシートを評価して、tenkiシートに展開するサンプルです。
4
+ 参考にならないと思いますが掲載しておきます。
5
+
6
+ ```VBA
7
+ Sub test()
8
+
9
+ Dim celno As Double
10
+ Dim num As Double
11
+
12
+ celno = 1
13
+
14
+ For i = 2 To 15
15
+
16
+ With Sheets("data")
17
+
18
+ 納入場所 = .Range("D" & i).Value
19
+
20
+ celno = celno + 1
21
+
22
+ If 納入場所 <> 前回納入場所 Then
23
+
24
+ num = 0
25
+
26
+ If i = 2 Then
27
+ Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
28
+ Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
29
+ Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
30
+ Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
31
+
32
+ ElseIf i <> 2 Then
33
+ celno = celno + 1
34
+
35
+ Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
36
+ Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
37
+ Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
38
+ Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
39
+
40
+ End If
41
+
42
+ End If
43
+
44
+
45
+ If 納入場所 = 前回納入場所 Then
46
+
47
+ num = num + 1
48
+
49
+ If num = 4 Then
50
+
51
+ celno = celno + 1
52
+
53
+ Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
54
+ Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
55
+ Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
56
+ Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
57
+
58
+ num = 0
59
+
60
+ Else
61
+ Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
62
+ Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
63
+ Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
64
+ Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
65
+
66
+ End If
67
+
68
+ End If
69
+
70
+
71
+
72
+ 前回納入場所 = 納入場所
73
+
74
+ End With
75
+
76
+ Next
77
+
78
+ End Sub
79
+ ```

4

削除

2020/07/29 08:25

投稿

mako1972
mako1972

スコア383

answer CHANGED
@@ -1,88 +1,1 @@
1
- 元シートをdata、転記先をtenkiとします。
2
- tenkiシートのA1～D1にはタイトル行があるものとします。
3
- 下記マクロを実行するとtenkiシートにブロックに分けて転写されると思います。
4
-
5
- celno = celno + 1という部分のカウンター変数を増やしたりすることで
6
- 転記場所を変動させています。
1
+ コメント無駄なので削除します。
7
-
8
- num変数で４件か否かをチェックし、納入場所が変わると初期化して0としています。
9
- もう少しきれいに書けるような気もしますが、サンプルということで・・・。
10
-
11
- ```VBA
12
- Sub test()
13
-
14
- Dim celno As Double
15
- Dim num As Double
16
- Dim i As Double
17
- Dim 納品場所 As string
18
- Dim 前回納品場所　As string
19
-
20
- celno = 1
21
-
22
- For i = 2 To 15 '最大データ数の取得は省略します（ベタな指定です）。
23
-
24
- With Sheets("data")
25
-
26
- 納入場所 = .Range("D" & i).Value
27
-
28
- celno = celno + 1
29
-
30
- If 納入場所 <> 前回納入場所 Then
31
-
32
- num = 0
33
-
34
- If i = 2 Then
35
- Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
36
- Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
37
- Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
38
- Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
39
-
40
- ElseIf i <> 2 Then
41
- celno = celno + 1
42
-
43
- Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
44
- Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
45
- Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
46
- Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
47
-
48
- End If
49
-
50
- End If
51
-
52
-
53
- If 納入場所 = 前回納入場所 Then
54
-
55
- num = num + 1
56
-
57
- If num = 4 Then
58
-
59
- celno = celno + 1
60
-
61
- Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
62
- Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
63
- Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
64
- Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
65
-
66
- num = 0
67
-
68
- Else
69
- Sheets("tenki").Range("A" & celno).Value = .Range("A" & i).Value
70
- Sheets("tenki").Range("B" & celno).Value = .Range("B" & i).Value
71
- Sheets("tenki").Range("C" & celno).Value = .Range("C" & i).Value
72
- Sheets("tenki").Range("D" & celno).Value = .Range("D" & i).Value
73
-
74
- End If
75
-
76
- End If
77
-
78
-
79
-
80
- 前回納入場所 = 納入場所
81
-
82
- End With
83
-
84
- Next
85
-
86
- End Sub
87
-
88
- ```

3

こちらかがいいかも

2020/07/28 23:37

投稿

mako1972
mako1972

スコア383

answer CHANGED
@@ -1,10 +1,11 @@
1
+ 元シートをdata、転記先をtenkiとします。
1
- 元シートをdata、転記先をtenkiとします。tenkiシートのA1～D1にはタイトル行があるものとします。
2
+ tenkiシートのA1～D1にはタイトル行があるものとします。
2
- 下記マクロを実行するとブロックに分けて転写されると思います。
3
+ 下記マクロを実行するとtenkiシートにブロックに分けて転写されると思います。
3
4
 
4
5
  celno = celno + 1という部分のカウンター変数を増やしたりすることで
5
6
  転記場所を変動させています。
6
7
 
7
- num変数で４件か否かをチェックし、納入場所が変わると初期化して０としています。
8
+ num変数で４件か否かをチェックし、納入場所が変わると初期化して0としています。
8
9
  もう少しきれいに書けるような気もしますが、サンプルということで・・・。
9
10
 
10
11
  ```VBA
@@ -12,9 +13,9 @@
12
13
 
13
14
  Dim celno As Double
14
15
  Dim num As Double
15
- dim i as Double
16
+ Dim i As Double
16
- dim 納品場所 As string
17
+ Dim 納品場所 As string
17
- dim 前回納品場所　As string
18
+ Dim 前回納品場所　As string
18
19
 
19
20
  celno = 1
20
21
 

2

こちらかがいいかも

2020/07/28 00:44

投稿

mako1972
mako1972

スコア383

answer CHANGED
@@ -13,10 +13,12 @@
13
13
  Dim celno As Double
14
14
  Dim num As Double
15
15
  dim i as Double
16
+ dim 納品場所 As string
17
+ dim 前回納品場所　As string
16
18
 
17
19
  celno = 1
18
20
 
19
- For i = 2 To 15
21
+ For i = 2 To 15 '最大データ数の取得は省略します（ベタな指定です）。
20
22
 
21
23
  With Sheets("data")
22
24
 

1

こちらかがいいかも

2020/07/28 00:36

投稿

mako1972
mako1972

スコア383

answer CHANGED
@@ -12,10 +12,11 @@
12
12
 
13
13
  Dim celno As Double
14
14
  Dim num As Double
15
+ dim i as Double
15
16
 
16
17
  celno = 1
17
18
 
18
- For i = 2 To 15
19
+ For i = 2 To 15
19
20
 
20
21
  With Sheets("data")
21
22