回答編集履歴
2
コード追記
test
CHANGED
@@ -91,3 +91,83 @@
|
|
91
91
|
結局、無意味な部分が多すぎてコードを見ただけでは何をしたいのか把握できません。
|
92
92
|
|
93
93
|
言葉で、何をしたいのかを詳細に説明してもらえますか。
|
94
|
+
|
95
|
+
|
96
|
+
|
97
|
+
|
98
|
+
|
99
|
+
---
|
100
|
+
|
101
|
+
提示された情報から最大限推測して、下記のような仕様だと仮定したコード例を提示しておきます。
|
102
|
+
|
103
|
+
|
104
|
+
|
105
|
+
仕様
|
106
|
+
|
107
|
+
"Data”シートに1行毎にフィルタ条件が記述してある
|
108
|
+
|
109
|
+
このフィルタ条件で"Sheet1"シートのデータにフィルターをかけて、それを"Sheet2"に順次追加コピーしていく。
|
110
|
+
|
111
|
+
|
112
|
+
|
113
|
+
コード例
|
114
|
+
|
115
|
+
```vba
|
116
|
+
|
117
|
+
Private Sub CommandButton3_Click()
|
118
|
+
|
119
|
+
Dim MotoRng As Range
|
120
|
+
|
121
|
+
Set MotoRng = Worksheets("Sheet1").Range("A1")
|
122
|
+
|
123
|
+
|
124
|
+
|
125
|
+
With Worksheets("Data")
|
126
|
+
|
127
|
+
Dim maxRow As Long
|
128
|
+
|
129
|
+
maxRow = .Range("A" & Rows.Count).End(xlUp).Row
|
130
|
+
|
131
|
+
'"Data"の2行目から順にループ処理
|
132
|
+
|
133
|
+
Dim rw As Long, cl As long
|
134
|
+
|
135
|
+
For rw = 2 To MaxRow
|
136
|
+
|
137
|
+
MotoRng.AutoFilter 'AutoFilter解除
|
138
|
+
|
139
|
+
'1列目から6列目までを条件にフィルターをかける
|
140
|
+
|
141
|
+
For cl = 1 To 6
|
142
|
+
|
143
|
+
MotoRng.AutoFilter cl, .Cells(rw, cl).Value
|
144
|
+
|
145
|
+
Next
|
146
|
+
|
147
|
+
'フィルターをかけた"Sheet1"のデータを"Sheet2"に追加コピーする
|
148
|
+
|
149
|
+
With Worksheets("Sheet2")
|
150
|
+
|
151
|
+
Dim Sheet2MaxRow As Long
|
152
|
+
|
153
|
+
Sheet2MaxRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
|
154
|
+
|
155
|
+
MotoRng.CurrentRegion.Copy .Range("A" & Sheet2MaxRow)
|
156
|
+
|
157
|
+
End With
|
158
|
+
|
159
|
+
Next
|
160
|
+
|
161
|
+
End With
|
162
|
+
|
163
|
+
|
164
|
+
|
165
|
+
MotoRng.AutoFilter 'AutoFilter解除
|
166
|
+
|
167
|
+
|
168
|
+
|
169
|
+
End Sub
|
170
|
+
|
171
|
+
```
|
172
|
+
|
173
|
+
テキストエディタ直書きなので動作確認してませんので、おかしなところがあるかも知れません。ロジックを参考にしてください。
|
1
コード修正
test
CHANGED
@@ -48,7 +48,7 @@
|
|
48
48
|
|
49
49
|
.AutoFilter 'AutoFilter解除
|
50
50
|
|
51
|
-
.AutoFilter 1, Kw(1)
|
51
|
+
.AutoFilter 1, Kw(1)
|
52
52
|
|
53
53
|
.AutoFilter 2, Kw(2)
|
54
54
|
|