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

編集履歴

質問編集履歴

6

補足

2020/11/18 08:52

投稿

sjsaijdi
sjsaijdi

スコア3

title CHANGED
File without changes
body CHANGED
@@ -91,7 +91,7 @@
91
91
  ActiveWorkbook.Worksheets("active").Range("A2:E" & cmax).AutoFilter Field:=2, Criteria1:=atai
92
92
 
93
93
  Dim j As Long
94
- For j = 1 To 12
94
+ For j = 1 To 5
95
95
  '1行目の各列のタイトルを書き込む
96
96
  Print #1, ActiveSheet.Cells(1, j).Value&; ",";
97
97
  Next j
@@ -101,7 +101,7 @@
101
101
  Dim c As Long, k As Long
102
102
 
103
103
  For c = 2 To lngRowMax
104
- For j = 1 To 12
104
+ For j = 1 To 5
105
105
  '絞り込んだデータを基にCSV書き込みを行う
106
106
  Print #1, ActiveSheet.Cells(c, j).Value&; ",";
107
107
  Next j

5

追記

2020/11/18 08:52

投稿

sjsaijdi
sjsaijdi

スコア3

title CHANGED
File without changes
body CHANGED
@@ -88,7 +88,7 @@
88
88
  End If
89
89
 
90
90
  'ataiの単語でB列のフィルター動作させる
91
- ActiveWorkbook.Worksheets("active").Range("A2:L" & cmax).AutoFilter Field:=2, Criteria1:=atai
91
+ ActiveWorkbook.Worksheets("active").Range("A2:E" & cmax).AutoFilter Field:=2, Criteria1:=atai
92
92
 
93
93
  Dim j As Long
94
94
  For j = 1 To 12

4

ソースコード修正

2020/11/18 08:01

投稿

sjsaijdi
sjsaijdi

スコア3

title CHANGED
File without changes
body CHANGED
@@ -52,65 +52,70 @@
52
52
 
53
53
  ```VBA
54
54
 
55
- '一部抜粋
55
+ Dim cmax
56
+ Dim csvFile As String
57
+ Dim i As Integer
58
+
59
+ SaveDir = ThisWorkbook.Path
56
60
 
57
- Dim max
58
- Dim i As Integer
59
- Dim j As Long
60
- Dim csvFile As String
61
- Dim atai As String
61
+ 'B列の最終行の数を取得
62
- Dim c As Long
62
+ cmax = Worksheets("active").Range("B65536").End(xlUp).row
63
- Dim k As Long
63
+
64
64
 
65
- 　　　'B列の最終行の数を取得
66
- 　　　max = Worksheets("active").Range("B65536").End(xlUp).row
67
65
 
68
- 　　　'最終行まで繰り返す
66
+ '最終行まで繰り返す
69
- 　　　For i = 2 To max
67
+ For i = 2 To cmax
70
68
 
69
+ Dim atai As String
71
- 　　　　　　'ataiにフィルターの絞込を行っている単語を入れる
70
+ 'ataiにフィルターの絞込を行っている単語を入れる
72
- 　　　　　　If atai <> Worksheets("active").Range("B" & i).Value Then
71
+ If atai <> Worksheets("active").Range("B" & i).Value Then
73
- 　　　　　　　　　atai = Worksheets("active").Range("B" & i).Value
72
+ atai = Worksheets("active").Range("B" & i).Value
74
- 　　　　　　End If
73
+ End If
74
+
75
+ '「フィルターの絞込を行っている単語名.csv」の名称のファイルをカレントディレクトリに作成する
76
+ csvFile = SaveDir & "\" & atai & ".csv"
75
77
 
76
- '「フィルターの絞込を行っている単語名.csv」の名称のファイルをカレントディレクトリに作成する
78
+ '高さをカウント
77
- 　　　　　　csvFile = SaveDir & "\" & atai & ".csv"
79
+ lngRowMax = Range("$A$" & Rows.Count).End(xlUp).row
78
-
79
-
80
- '書き込みを行うファイルを開く
81
- Open csvFile For Output As #1
82
80
 
83
- 　　　'フィルターの絞込がされていたら解除する
84
- If ActiveSheet.FilterMode = True Then
85
- 　　　ActiveSheet.ShowAllData
86
- End If
87
- 'ataiの単語でB列のフィルター動作させる
88
- ActiveWorkbook.Worksheets("active").Range("A2:E" & max).AutoFilter Field:=2, Criteria1:=atai
89
81
 
90
- For j = 1 To 12
91
- 　　　　　　　　　　　　'1行目の各行のタイトルを書き込む
82
+ '書き込みを行うファイルを開く
92
- 　　　Print #1, ActiveSheet.Cells(1, j).Value&; ",";
93
- Next j
94
- 　　　　　　　　　'改行
95
- Print #1, vbCr;
96
-
97
- For c = 2 To max
98
- 　　　For j = 1 To 12
99
- 　　　　　　　　　　　　　　　'絞り込んだデータを基にCSV書き込みを行う
83
+ Open csvFile For Output As #1
100
- 　　　　　　Print #1, ActiveSheet.Cells(c, j).Value&; ",";
101
- Next j
102
- 　　　　　　　　　　　　'改行
103
- Print #1, ActiveSheet.Cells(c, j).Value & vbCr;
104
- Next c
105
84
 
85
+ 'フィルターの絞込がされていたら解除する
86
+ If ActiveSheet.FilterMode = True Then
87
+ ActiveSheet.ShowAllData
88
+ End If
89
+
90
+ 'ataiの単語でB列のフィルター動作させる
91
+ ActiveWorkbook.Worksheets("active").Range("A2:L" & cmax).AutoFilter Field:=2, Criteria1:=atai
92
+
93
+ Dim j As Long
94
+ For j = 1 To 12
95
+ '1行目の各列のタイトルを書き込む
96
+ Print #1, ActiveSheet.Cells(1, j).Value&; ",";
97
+ Next j
98
+ '改行
99
+ Print #1, vbCr;
100
+
101
+ Dim c As Long, k As Long
102
+
103
+ For c = 2 To lngRowMax
104
+ For j = 1 To 12
105
+ '絞り込んだデータを基にCSV書き込みを行う
106
+ Print #1, ActiveSheet.Cells(c, j).Value&; ",";
107
+ Next j
108
+ '改行
109
+ Print #1, ActiveSheet.Cells(c, j).Value & vbCr;
110
+ Next c
106
- 'ファイルを閉じる
111
+ 'ファイルを閉じる
107
- Close #1
112
+ Close #1
108
-
113
+
109
- '次の行に行く
114
+ '次の行に行く
110
- 　　　Next i
115
+ Next i
111
-
116
+
112
117
  'フィルターの絞込を解除する（全件表示）
113
118
  If ActiveSheet.FilterMode = True Then
114
- 　　　ActiveSheet.ShowAllData
119
+ ActiveSheet.ShowAllData
115
120
  End If
116
121
  ```

3

追記

2020/11/18 08:00

投稿

sjsaijdi
sjsaijdi

スコア3

title CHANGED
File without changes
body CHANGED
@@ -55,6 +55,7 @@
55
55
  '一部抜粋
56
56
 
57
57
  Dim max
58
+ Dim i As Integer
58
59
  Dim j As Long
59
60
  Dim csvFile As String
60
61
  Dim atai As String

2

補足

2020/11/18 07:23

投稿

sjsaijdi
sjsaijdi

スコア3

title CHANGED
File without changes
body CHANGED
@@ -50,8 +50,10 @@
50
50
 
51
51
  ### 該当のソースコード
52
52
 
53
- ```ここに言語名を入力
53
+ ```VBA
54
54
 
55
+ '一部抜粋
56
+
55
57
  Dim max
56
58
  Dim j As Long
57
59
  Dim csvFile As String

1

補足

2020/11/18 06:20

投稿

sjsaijdi
sjsaijdi

スコア3

title CHANGED
File without changes
body CHANGED
@@ -3,7 +3,7 @@
3
3
  VBAを利用してExcelの値をCSVに出力するプログラムを作成しています。
4
4
  オートフィルターを利用してB列の絞込を行いながら順番に出力していきたいです。
5
5
 
6
- 例えば下記のような表があったときは列2の情報（東京都・愛知県・大阪府）で、別々のCSVとしてその行の情報を出力したいと思っています。
6
+ 例えば下記のような表があったときは列2の情報（東京都・愛知県・大阪府）で絞込を順に行い、別々のCSVとしてその行の情報を出力したいと思っています。
7
7
 
8
8
  |列1|列2|列3|列4|列5|
9
9
  |:--:|:--:|:--:|:--:|:--:|