回答編集履歴

1

追記

2020/03/21 09:21

投稿

mattuwan
mattuwan

スコア2163

test CHANGED
@@ -11,3 +11,101 @@
11
11
 
12
12
 
13
13
  サンプルコードが必要ですか?
14
+
15
+
16
+
17
+ ---
18
+
19
+ 追記
20
+
21
+
22
+
23
+ セルを順次個々にみて転記していくサンプルです。
24
+
25
+ ```ExcelVBA
26
+
27
+ Sub test_A()
28
+
29
+ Dim rngCopyFrom As Range '複写元セル範囲
30
+
31
+ Dim rngCopyTo As Range '貼付先セル範囲
32
+
33
+ Dim c As Range '各セル
34
+
35
+ Dim ixRow As Long '行の番号(相対位置)
36
+
37
+ Dim ixArea As Long '矩形の番号
38
+
39
+
40
+
41
+ '前提条件の定義
42
+
43
+ With Worksheets("リスト表").Range("A6").CurrentRegion
44
+
45
+ Set rngCopyFrom = Intersect(.Cells, .Offset(1))
46
+
47
+ End With
48
+
49
+ Set rngCopyTo = Worksheets("リストAパターン").Range("H16:H36,H54:H74")
50
+
51
+
52
+
53
+ ixArea = 1 'コピー先矩形の番号(初期値)
54
+
55
+ '1列目の各セルを順次見て行く
56
+
57
+ For Each c In rngCopyFrom.Columns(1).Cells
58
+
59
+ 'もし、今見ているセルが〇なら、
60
+
61
+ If c.Value = "○" Then
62
+
63
+ ixRow = ixRow + 1 '次の貼付先行番号の用意
64
+
65
+ 'もし、貼り付け先行番号が21を越えたら、変数を次の矩形用に初期化
66
+
67
+ If ixRow > 21 Then
68
+
69
+ ixArea = ixArea + 1
70
+
71
+ ixRow = 1
72
+
73
+ End If
74
+
75
+ '見ているセルの3列右を貼り付け先のixArea番目の矩形のixRow番目の行にコピペ
76
+
77
+ c.Offset(, 3).Copy rngCopyTo.Areas(ixArea).Cells(ixRow, 1)
78
+
79
+ End If
80
+
81
+ Next
82
+
83
+ End Sub
84
+
85
+ ```
86
+
87
+ 操作対象はセルなので、変数はRange型を用意しておけば、
88
+
89
+ ワークシート用の変数は必要ないです。
90
+
91
+ 1回変数に、「ここのシートの、このセル範囲」と入れておけば、
92
+
93
+ どこのシートに所属しているか、情報を持っています。
94
+
95
+
96
+
97
+ あと、並び替えを使った例や、オートフィルターを使った例もサンプル書きますか?
98
+
99
+ もう、おなかいっぱいですか?
100
+
101
+ 並び替えを使ったら処理速度が速いと思いますが、
102
+
103
+ 行数が知れているので、体感で違いが解らないかもしれませんね。
104
+
105
+
106
+
107
+ あ、値のみ転記でしたね。
108
+
109
+ それくらいの変更は、ご自分でチャレンジしていただきたいかな。
110
+
111
+ 勉強なので。