teratail
回答率
85.37%
teratail 10th-anniversary
teratail 10th-anniversary
質問するログイン新規登録
トップに関する質問マクロを使い、オートフィルターする方法

編集履歴

質問編集履歴

10

修正

2021/06/06 11:55

投稿

m_ao
m_ao

スコア5

test CHANGED
File without changes
test CHANGED
@@ -5,18 +5,6 @@
5
5
  Excelで在庫管理をしようとしています。
6
6
 
7
7
  DATAにA列からE列で記載された条件を用いて一個づつSheet1にフィルターをかけて、Sheet2に記載していきたい。
8
-
9
- 色々と検索し、下記コードを試してみました。
10
-
11
- ただ、私の場合オートフィルターをかけたい列が、Sheet1のB,D,F,G,I,J列です。
12
-
13
- for next の不連続ができるでしょうか
14
-
15
- For cl = 1 To 6 の様に連続ではなく　2,4,6,7,9,10 などのように
16
-
17
- 規則性のない場合の方法を探しています
18
-
19
- よろしくお願いいたします
20
8
 
21
9
 
22
10
 

9

誤記

2021/06/06 11:55

投稿

m_ao
m_ao

スコア5

test CHANGED
File without changes
test CHANGED
@@ -157,29 +157,3 @@
157
157
 
158
158
 
159
159
  ```
160
-
161
-
162
-
163
- ### 試したこと
164
-
165
- この状態ですと、オートフィルターで検索できるものがなく、見出しのみがSheet2に表示されます。どうすれば解決できますでしょうか。
166
-
167
- 宜しくお願い致します。
168
-
169
-
170
-
171
- Dataシート
172
-
173
- |商品|code|size|Store|type|Price|
174
-
175
- |商A| 2| S| A| A|1500|
176
-
177
- |商B| 3| M| B| C|2000|
178
-
179
- |商C| 10| L| C| C|1500|
180
-
181
-
182
-
183
- Sheet1
184
-
185
- ![](51044a5322c78943af7a2b7658211b36.png)

8

追加

2020/07/19 11:40

投稿

m_ao
m_ao

スコア5

test CHANGED
File without changes
test CHANGED
@@ -77,6 +77,8 @@
77
77
  End With
78
78
 
79
79
  ```
80
+
81
+ 追加
80
82
 
81
83
  ```VBA
82
84
 

7

修正

2020/06/01 08:24

投稿

m_ao
m_ao

スコア5

test CHANGED
File without changes
test CHANGED
@@ -78,7 +78,83 @@
78
78
 
79
79
  ```
80
80
 
81
+ ```VBA
81
82
 
83
+ Private Sub CommandButton1_Click()
84
+
85
+ Dim aaa As Variant
86
+
87
+ aaa = Array(2, 4, 6, 7, 9, 10)
88
+
89
+ Dim MotoRng As Range
90
+
91
+ Set MotoRng = Worksheets("Sheet1").Range("A1")
92
+
93
+
94
+
95
+
96
+
97
+ With Worksheets("Data")
98
+
99
+ Dim maxRow As Long
100
+
101
+ maxRow = .Range("A" & Rows.Count).End(xlUp).Row
102
+
103
+ '"Data"の2行目から順にループ処理
104
+
105
+ Dim rw As Long, cl As Long
106
+
107
+ For rw = 2 To maxRow
108
+
109
+ MotoRng.AutoFilter 'AutoFilter解除
110
+
111
+ '2列目から6列目までを条件にフィルターをかける
112
+
113
+ For cl = 0 To UBound(aaa)
114
+
115
+ Debug.Print cl
116
+
117
+ Debug.Print rw
118
+
119
+
120
+
121
+ MotoRng.AutoFilter aaa(cl), .Cells(rw, cl + 1).Value
122
+
123
+ Next
124
+
125
+ 'フィルターをかけた"Sheet1"のデータを"Sheet4"に追加コピーする
126
+
127
+ With Worksheets("Sheet4")
128
+
129
+ Dim Sheet4MaxRow As Long
130
+
131
+ Sheet4MaxRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
132
+
133
+
134
+
135
+
136
+
137
+ Intersect(Range("A1").CurrentRegion, Range("B:B,D:D,G:G,M:M")).Copy _
138
+
139
+ Sheets("Sheet4").Range("A" & Sheet4MaxRow)
140
+
141
+ End With
142
+
143
+ Next
144
+
145
+ End With
146
+
147
+
148
+
149
+ MotoRng.AutoFilter 'AutoFilter解除
150
+
151
+
152
+
153
+ End Sub
154
+
155
+
156
+
157
+ ```
82
158
 
83
159
 
84
160
 

6

誤記修正

2020/06/01 08:16

投稿

m_ao
m_ao

スコア5

test CHANGED
@@ -1 +1 @@
1
- マクロを使い、オートフィルタする方法
1
+ マクロを使い、オートフィルターする方法
test CHANGED
@@ -1,6 +1,6 @@
1
1
  ### 前提・実現したいこと
2
2
 
3
- オートフィルタのVBAで教えてほしい事があります。
3
+ オートフィルターのVBAで教えてほしい事があります。
4
4
 
5
5
  Excelで在庫管理をしようとしています。
6
6
 
@@ -8,7 +8,7 @@
8
8
 
9
9
  色々と検索し、下記コードを試してみました。
10
10
 
11
- ただ、私の場合オートフィルタをかけたい列が、Sheet1のB,D,F,G,I,J列です。
11
+ ただ、私の場合オートフィルターをかけたい列が、Sheet1のB,D,F,G,I,J列です。
12
12
 
13
13
  for next の不連続ができるでしょうか
14
14
 
@@ -84,7 +84,7 @@
84
84
 
85
85
  ### 試したこと
86
86
 
87
- この状態ですと、オートフィルタで検索できるものがなく、見出しのみがSheet2に表示されます。どうすれば解決できますでしょうか。
87
+ この状態ですと、オートフィルターで検索できるものがなく、見出しのみがSheet2に表示されます。どうすれば解決できますでしょうか。
88
88
 
89
89
  宜しくお願い致します。
90
90
 
@@ -105,7 +105,3 @@
105
105
  Sheet1
106
106
 
107
107
  ![](51044a5322c78943af7a2b7658211b36.png)
108
-
109
- Sheet2
110
-
111
- ![](695cd0c24512a0182b6a5b3f86e16668.png)

5

誤記

2020/05/31 06:38

投稿

m_ao
m_ao

スコア5

test CHANGED
@@ -1 +1 @@
1
- マクロを使い、オートフィルする方法
1
+ マクロを使い、オートフィルタする方法
test CHANGED
@@ -8,7 +8,7 @@
8
8
 
9
9
  色々と検索し、下記コードを試してみました。
10
10
 
11
- ただ、私の場合オートフィルをかけたい列が、Sheet1のB,D,F,G,I,J列です。
11
+ ただ、私の場合オートフィルタをかけたい列が、Sheet1のB,D,F,G,I,J列です。
12
12
 
13
13
  for next の不連続ができるでしょうか
14
14
 
@@ -50,7 +50,7 @@
50
50
 
51
51
  MotoRng.AutoFilter 'AutoFilter解除
52
52
 
53
- '2, 4, 6, 7, 9, 10列を条件にフィルターをかける
53
+ '2, 4, 6, 7, 9, 10列を条件にフィルタをかける
54
54
 
55
55
  For cl = 2 To UBound(aaa)
56
56
 
@@ -60,7 +60,7 @@
60
60
 
61
61
  Next
62
62
 
63
- 'フィルターをかけた"Sheet1"のデータを"Sheet2"に追加コピーする
63
+ 'フィルタをかけた"Sheet1"のデータを"Sheet2"に追加コピーする
64
64
 
65
65
  With Worksheets("Sheet2")
66
66
 
@@ -84,7 +84,7 @@
84
84
 
85
85
  ### 試したこと
86
86
 
87
- この状態ですと、オートフィルで検索できるものがなく、見出しのみがSheet2に表示されます。どうすれば解決できますでしょうか。
87
+ この状態ですと、オートフィルタで検索できるものがなく、見出しのみがSheet2に表示されます。どうすれば解決できますでしょうか。
88
88
 
89
89
  宜しくお願い致します。
90
90
 

4

誤記

2020/05/31 06:07

投稿

m_ao
m_ao

スコア5

test CHANGED
File without changes
test CHANGED
@@ -24,7 +24,7 @@
24
24
 
25
25
  Private Sub CommandButton1_Click()
26
26
 
27
- Dim aaa() As Variant
27
+ Dim aaa As Variant
28
28
 
29
29
  aaa = Array(2, 4, 6, 7, 9, 10)
30
30
 

3

画像追加

2020/05/31 01:28

投稿

m_ao
m_ao

スコア5

test CHANGED
File without changes
test CHANGED
@@ -92,22 +92,20 @@
92
92
 
93
93
  Dataシート
94
94
 
95
- |商品|code|Store|type|Price|
95
+ |商品|code|size|Store|type|Price|
96
96
 
97
97
  |商A| 2| S| A| A|1500|
98
98
 
99
99
  |商B| 3| M| B| C|2000|
100
100
 
101
- |商C| 10| L| C| C|3000|
101
+ |商C| 10| L| C| C|1500|
102
102
 
103
103
 
104
104
 
105
+ Sheet1
105
106
 
107
+ ![](51044a5322c78943af7a2b7658211b36.png)
106
108
 
109
+ Sheet2
107
110
 
108
-
109
-
110
-
111
-
112
-
113
- ここにより詳細な情報を記載してください。
111
+ ![](695cd0c24512a0182b6a5b3f86e16668.png)

2

修正

2020/05/31 01:22

投稿

m_ao
m_ao

スコア5

test CHANGED
File without changes
test CHANGED
@@ -90,7 +90,21 @@
90
90
 
91
91
 
92
92
 
93
- 抽出条件（Dataシート）
93
+ Dataシート
94
+
95
+ |商品|code|Store|type|Price|
96
+
97
+ |商A| 2| S| A| A|1500|
98
+
99
+ |商B| 3| M| B| C|2000|
100
+
101
+ |商C| 10| L| C| C|3000|
102
+
103
+
104
+
105
+
106
+
107
+
94
108
 
95
109
 
96
110
 

1

誤記

2020/05/31 00:47

投稿

m_ao
m_ao

スコア5

test CHANGED
File without changes
test CHANGED
@@ -20,11 +20,19 @@
20
20
 
21
21
 
22
22
 
23
- Private Sub CommandButton3_Click()
23
+ ```ここに言語を入力
24
24
 
25
+ Private Sub CommandButton1_Click()
26
+
27
+ Dim aaa() As Variant
28
+
29
+ aaa = Array(2, 4, 6, 7, 9, 10)
30
+
25
- Dim MotoRng As Range
31
+ Dim MotoRng As Range
26
32
 
27
33
  Set MotoRng = Worksheets("Sheet1").Range("A1")
34
+
35
+
28
36
 
29
37
 
30
38
 
@@ -36,15 +44,17 @@
36
44
 
37
45
  '"Data"の2行目から順にループ処理
38
46
 
39
- Dim rw As Long, cl As long
47
+ Dim rw As Long, cl As Long
40
48
 
41
- For rw = 2 To MaxRow
49
+ For rw = 2 To maxRow
42
50
 
43
51
  MotoRng.AutoFilter 'AutoFilter解除
44
52
 
45
- '1列目から5列目までを条件にフィルターをかける
53
+ '2, 4, 6, 7, 9, 10列を条件にフィルターをかける
46
54
 
47
- For cl = 1 To 6
55
+ For cl = 2 To UBound(aaa)
56
+
57
+
48
58
 
49
59
  MotoRng.AutoFilter cl, .Cells(rw, cl).Value
50
60
 
@@ -66,13 +76,7 @@
66
76
 
67
77
  End With
68
78
 
69
-
70
-
71
- MotoRng.AutoFilter 'AutoFilter解除
72
-
73
-
74
-
75
- End Sub
79
+ ```
76
80
 
77
81
 
78
82
 
@@ -86,6 +90,10 @@
86
90
 
87
91
 
88
92
 
93
+ 抽出条件（Dataシート）
94
+
95
+
96
+
89
97
 
90
98
 
91
99
  ここにより詳細な情報を記載してください。