teratail
回答率
85.35%
teratail header banner
teratail header banner
質問するログイン新規登録
トップに関する質問VBAのオートフィルターを使ってCSV出力を行いたい

編集履歴

質問編集履歴

6

補足

2020/11/18 08:52

投稿

sjsaijdi
sjsaijdi

スコア3

test CHANGED
File without changes
test CHANGED
@@ -184,7 +184,7 @@
184
184
 
185
185
  Dim j As Long
186
186
 
187
- For j = 1 To 12
187
+ For j = 1 To 5
188
188
 
189
189
  '1行目の各列のタイトルを書き込む
190
190
 
@@ -204,7 +204,7 @@
204
204
 
205
205
  For c = 2 To lngRowMax
206
206
 
207
- For j = 1 To 12
207
+ For j = 1 To 5
208
208
 
209
209
  '絞り込んだデータを基にCSV書き込みを行う
210
210
 

5

追記

2020/11/18 08:52

投稿

sjsaijdi
sjsaijdi

スコア3

test CHANGED
File without changes
test CHANGED
@@ -178,7 +178,7 @@
178
178
 
179
179
  'ataiの単語でB列のフィルター動作させる
180
180
 
181
- ActiveWorkbook.Worksheets("active").Range("A2:L" & cmax).AutoFilter Field:=2, Criteria1:=atai
181
+ ActiveWorkbook.Worksheets("active").Range("A2:E" & cmax).AutoFilter Field:=2, Criteria1:=atai
182
182
 
183
183
 
184
184
 

4

ソースコード修正

2020/11/18 08:01

投稿

sjsaijdi
sjsaijdi

スコア3

test CHANGED
File without changes
test CHANGED
@@ -106,125 +106,135 @@
106
106
 
107
107
 
108
108
 
109
- '一部抜粋
110
-
111
-
112
-
113
- Dim max
109
+ Dim cmax
110
+
114
-
111
+ Dim csvFile As String
112
+
115
- Dim i As Integer
113
+ Dim i As Integer
114
+
115
+
116
+
116
-
117
+ SaveDir = ThisWorkbook.Path
118
+
119
+
120
+
121
+ 'B列の最終行の数を取得
122
+
123
+ cmax = Worksheets("active").Range("B65536").End(xlUp).row
124
+
125
+
126
+
127
+
128
+
129
+
130
+
131
+ '最終行まで繰り返す
132
+
117
- Dim j As Long
133
+ For i = 2 To cmax
118
-
119
- Dim csvFile As String
134
+
120
-
135
+
136
+
121
- Dim atai As String
137
+ Dim atai As String
122
-
123
- Dim c As Long
138
+
124
-
125
- Dim k As Long
126
-
127
-
128
-
129
- 　　　'B列の最終行の数を取得
130
-
131
- 　　　max = Worksheets("active").Range("B65536").End(xlUp).row
132
-
133
-
134
-
135
- 　　　'最終行まで繰り返す
136
-
137
- 　　　For i = 2 To max
138
-
139
-
140
-
141
- 　　　　　　'ataiにフィルターの絞込を行っている単語を入れる
139
+ 'ataiにフィルターの絞込を行っている単語を入れる
142
-
140
+
143
- 　　　　　　If atai <> Worksheets("active").Range("B" & i).Value Then
141
+ If atai <> Worksheets("active").Range("B" & i).Value Then
144
-
142
+
145
- 　　　　　　　　　atai = Worksheets("active").Range("B" & i).Value
143
+ atai = Worksheets("active").Range("B" & i).Value
146
-
144
+
147
- 　　　　　　End If
145
+ End If
146
+
147
+
148
+
149
+ '「フィルターの絞込を行っている単語名.csv」の名称のファイルをカレントディレクトリに作成する
150
+
151
+ csvFile = SaveDir & "\" & atai & ".csv"
148
152
 
149
153
 
150
154
 
151
- '「フィルターの絞込を行っている単語名.csv」の名称のファイルをカレントディレクトリに作成する
152
-
153
- 　　　　　　csvFile = SaveDir & "\" & atai & ".csv"
154
-
155
-
156
-
157
-
158
-
159
- '書き込みを行うファイルを開く
160
-
161
- Open csvFile For Output As #1
162
-
163
-
164
-
165
- 　　　'フィルターの絞込がされていたら解除する
166
-
167
- If ActiveSheet.FilterMode = True Then
168
-
169
- 　　　ActiveSheet.ShowAllData
170
-
171
- End If
172
-
173
- 'ataiの単語でB列のフィルター動作させる
174
-
175
- ActiveWorkbook.Worksheets("active").Range("A2:E" & max).AutoFilter Field:=2, Criteria1:=atai
176
-
177
-
178
-
179
- For j = 1 To 12
180
-
181
- 　　　　　　　　　　　　'1行目の各行のタイトルを書き込む
182
-
183
- 　　　Print #1, ActiveSheet.Cells(1, j).Value&; ",";
184
-
185
- Next j
186
-
187
- 　　　　　　　　　'改行
188
-
189
- Print #1, vbCr;
190
-
191
-
192
-
193
- For c = 2 To max
194
-
195
- 　　　For j = 1 To 12
196
-
197
- 　　　　　　　　　　　　　　　'絞り込んだデータを基にCSV書き込みを行う
198
-
199
- 　　　　　　Print #1, ActiveSheet.Cells(c, j).Value&; ",";
200
-
201
- Next j
202
-
203
- 　　　　　　　　　　　　'改行
204
-
205
- Print #1, ActiveSheet.Cells(c, j).Value & vbCr;
206
-
207
- Next c
208
-
209
-
210
-
211
- 'ファイルを閉じる
212
-
213
- Close #1
214
-
215
-
216
-
217
- '次の行に行く
218
-
219
- 　　　Next i
220
-
221
-
155
+ '高さをカウント
156
+
157
+ lngRowMax = Range("$A$" & Rows.Count).End(xlUp).row
158
+
159
+
160
+
161
+
162
+
163
+ '書き込みを行うファイルを開く
164
+
165
+ Open csvFile For Output As #1
166
+
167
+
168
+
169
+ 'フィルターの絞込がされていたら解除する
170
+
171
+ If ActiveSheet.FilterMode = True Then
172
+
173
+ ActiveSheet.ShowAllData
174
+
175
+ End If
176
+
177
+
178
+
179
+ 'ataiの単語でB列のフィルター動作させる
180
+
181
+ ActiveWorkbook.Worksheets("active").Range("A2:L" & cmax).AutoFilter Field:=2, Criteria1:=atai
182
+
183
+
184
+
185
+ Dim j As Long
186
+
187
+ For j = 1 To 12
188
+
189
+ '1行目の各列のタイトルを書き込む
190
+
191
+ Print #1, ActiveSheet.Cells(1, j).Value&; ",";
192
+
193
+ Next j
194
+
195
+ '改行
196
+
197
+ Print #1, vbCr;
198
+
199
+
200
+
201
+ Dim c As Long, k As Long
202
+
203
+
204
+
205
+ For c = 2 To lngRowMax
206
+
207
+ For j = 1 To 12
208
+
209
+ '絞り込んだデータを基にCSV書き込みを行う
210
+
211
+ Print #1, ActiveSheet.Cells(c, j).Value&; ",";
212
+
213
+ Next j
214
+
215
+ '改行
216
+
217
+ Print #1, ActiveSheet.Cells(c, j).Value & vbCr;
218
+
219
+ Next c
220
+
221
+ 'ファイルを閉じる
222
+
223
+ Close #1
224
+
225
+
226
+
227
+ '次の行に行く
228
+
229
+ Next i
230
+
231
+
222
232
 
223
233
  'フィルターの絞込を解除する（全件表示）
224
234
 
225
235
  If ActiveSheet.FilterMode = True Then
226
236
 
227
- 　　　ActiveSheet.ShowAllData
237
+ ActiveSheet.ShowAllData
228
238
 
229
239
  End If
230
240
 

3

追記

2020/11/18 08:00

投稿

sjsaijdi
sjsaijdi

スコア3

test CHANGED
File without changes
test CHANGED
@@ -112,6 +112,8 @@
112
112
 
113
113
  Dim max
114
114
 
115
+ Dim i As Integer
116
+
115
117
  Dim j As Long
116
118
 
117
119
  Dim csvFile As String

2

補足

2020/11/18 07:23

投稿

sjsaijdi
sjsaijdi

スコア3

test CHANGED
File without changes
test CHANGED
@@ -102,7 +102,11 @@
102
102
 
103
103
 
104
104
 
105
- ```ここに言語名を入力
105
+ ```VBA
106
+
107
+
108
+
109
+ '一部抜粋
106
110
 
107
111
 
108
112
 

1

補足

2020/11/18 06:20

投稿

sjsaijdi
sjsaijdi

スコア3

test CHANGED
File without changes
test CHANGED
@@ -8,7 +8,7 @@
8
8
 
9
9
 
10
10
 
11
- 例えば下記のような表があったときは列2の情報（東京都・愛知県・大阪府）で、別々のCSVとしてその行の情報を出力したいと思っています。
11
+ 例えば下記のような表があったときは列2の情報（東京都・愛知県・大阪府）で絞込を順に行い、別々のCSVとしてその行の情報を出力したいと思っています。
12
12
 
13
13
 
14
14