回答編集履歴
2
コード追記
answer
CHANGED
|
@@ -44,4 +44,44 @@
|
|
|
44
44
|
```
|
|
45
45
|
|
|
46
46
|
結局、無意味な部分が多すぎてコードを見ただけでは何をしたいのか把握できません。
|
|
47
|
-
言葉で、何をしたいのかを詳細に説明してもらえますか。
|
|
47
|
+
言葉で、何をしたいのかを詳細に説明してもらえますか。
|
|
48
|
+
|
|
49
|
+
|
|
50
|
+
---
|
|
51
|
+
提示された情報から最大限推測して、下記のような仕様だと仮定したコード例を提示しておきます。
|
|
52
|
+
|
|
53
|
+
仕様
|
|
54
|
+
"Data”シートに1行毎にフィルタ条件が記述してある
|
|
55
|
+
このフィルタ条件で"Sheet1"シートのデータにフィルターをかけて、それを"Sheet2"に順次追加コピーしていく。
|
|
56
|
+
|
|
57
|
+
コード例
|
|
58
|
+
```vba
|
|
59
|
+
Private Sub CommandButton3_Click()
|
|
60
|
+
Dim MotoRng As Range
|
|
61
|
+
Set MotoRng = Worksheets("Sheet1").Range("A1")
|
|
62
|
+
|
|
63
|
+
With Worksheets("Data")
|
|
64
|
+
Dim maxRow As Long
|
|
65
|
+
maxRow = .Range("A" & Rows.Count).End(xlUp).Row
|
|
66
|
+
'"Data"の2行目から順にループ処理
|
|
67
|
+
Dim rw As Long, cl As long
|
|
68
|
+
For rw = 2 To MaxRow
|
|
69
|
+
MotoRng.AutoFilter 'AutoFilter解除
|
|
70
|
+
'1列目から6列目までを条件にフィルターをかける
|
|
71
|
+
For cl = 1 To 6
|
|
72
|
+
MotoRng.AutoFilter cl, .Cells(rw, cl).Value
|
|
73
|
+
Next
|
|
74
|
+
'フィルターをかけた"Sheet1"のデータを"Sheet2"に追加コピーする
|
|
75
|
+
With Worksheets("Sheet2")
|
|
76
|
+
Dim Sheet2MaxRow As Long
|
|
77
|
+
Sheet2MaxRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
|
|
78
|
+
MotoRng.CurrentRegion.Copy .Range("A" & Sheet2MaxRow)
|
|
79
|
+
End With
|
|
80
|
+
Next
|
|
81
|
+
End With
|
|
82
|
+
|
|
83
|
+
MotoRng.AutoFilter 'AutoFilter解除
|
|
84
|
+
|
|
85
|
+
End Sub
|
|
86
|
+
```
|
|
87
|
+
テキストエディタ直書きなので動作確認してませんので、おかしなところがあるかも知れません。ロジックを参考にしてください。
|
1
コード修正
answer
CHANGED
|
@@ -23,7 +23,7 @@
|
|
|
23
23
|
|
|
24
24
|
With Worksheets("Sheet1").Range("A1")
|
|
25
25
|
.AutoFilter 'AutoFilter解除
|
|
26
|
-
.AutoFilter 1, Kw(1)
|
|
26
|
+
.AutoFilter 1, Kw(1)
|
|
27
27
|
.AutoFilter 2, Kw(2)
|
|
28
28
|
.AutoFilter 3, Kw(3)
|
|
29
29
|
|