回答編集履歴
1
追記
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
|
+
勉強なので。
|