teratail
回答率
85.31%
teratail header banner
teratail header banner
質問するログイン新規登録
トップに関する質問CSVデータのマクロでの取り込み方が分からない

編集履歴

質問編集履歴

3

イメージ挿入

2017/05/23 07:22

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -34,6 +34,14 @@
34
34
 
35
35
 
36
36
 
37
+ ☆データ加工マクロ☆は指定のタイトル列を丸ごとコピーして抽出データシートに張り付けています。
38
+
39
+
40
+
41
+ 新しい他のデータを同じようにマクロをかけたときに重複するデータを探すキーはA列の申請№で確認したいのですが、作ったマクロを実行すると、列ごとにコピペするようになっているため、そのほかの列は重複が分からず全部のデータを張り付けてしまうためわからなくなっています。
42
+
43
+ ![イメージ説明](8306e1c6dc59d3e5e0d82e37bdcb57bd.jpeg)
44
+
37
45
  ###該当のソースコード
38
46
 
39
47
  ☆CSV取り込みマクロ☆

2

作成マクロの更新

2017/05/23 07:22

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -2,7 +2,11 @@
2
2
 
3
3
  CSVで出力したデータを必要な列のみ取り出して
4
4
 
5
- 見出しを付けたExcelのデータに取り込みたい。
5
+ Excelのデータに取り込みたい。
6
+
7
+
8
+
9
+ その際、用意している定型のタイトル行を加工データに挿入したい。
6
10
 
7
11
 
8
12
 
@@ -12,9 +16,7 @@
12
16
 
13
17
 
14
18
 
15
- 初心者の為、マクロの記録で作業を行っており
19
+
16
-
17
- コードが無駄に長くなってしまいました
18
20
 
19
21
 
20
22
 
@@ -24,241 +26,229 @@
24
26
 
25
27
 
26
28
 
29
+ ①CSVの取り込みマクロを作成したが、単体で作ったためどこに入れればワンクリックでマクロを起動した際、CSV取り込み→表作成と流れるようにマクロが動くのかわからない。
30
+
31
+ ②自分で用意したタイトル行を入れる方法が分からない
32
+
27
- ```
33
+ ③重複しないデータを取り込む方法がわからない
28
-
29
-
30
-
31
- ```
32
34
 
33
35
 
34
36
 
35
37
  ###該当のソースコード
36
38
 
37
- ```ここに言語を入力
38
-
39
- Sub Macro2()
40
-
41
- '
42
-
43
- ' Macro2 Macro
44
-
45
- '
46
-
47
-
48
-
49
- '
50
-
51
- Range("A2:CB2").Select
52
-
53
- Range(Selection, Selection.End(xlDown)).Select
54
-
55
- ActiveWindow.SmallScroll Down:=3
56
-
57
- Selection.Copy
58
-
59
- Sheets("Sheet4").Select
60
-
61
- Range("A2").Select
62
-
63
- Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
64
-
65
- :=False, Transpose:=False
66
-
67
- Range("A1").Select
68
-
69
- Range(Selection, Selection.End(xlToRight)).Select
70
-
71
- Range("A1:CA1").Select
72
-
73
- Range(Selection, Selection.End(xlDown)).Select
74
-
75
- Range("B2:CB2").Select
76
-
77
- Range(Selection, Selection.End(xlDown)).Select
78
-
79
- Application.CutCopyMode = False
80
-
81
- Selection.Copy
82
-
83
- ActiveWindow.SmallScroll Down:=3
84
-
85
- Sheets("Sheet5").Select
86
-
87
- Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
88
-
89
- False, Transpose:=True
90
-
91
- Columns("A:A").Select
92
-
93
- Application.CutCopyMode = False
94
-
95
- Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
96
-
97
- Rows("1:1").Select
98
-
99
- Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
100
-
101
- Range("A2").Select
102
-
103
- Sheets("Sheet3").Select
104
-
105
- ActiveWindow.SmallScroll Down:=-6
106
-
107
- Sheets("Sheet4").Select
108
-
109
- ActiveWindow.SmallScroll Down:=-99
110
-
111
- Range("BF97").Select
112
-
113
- Selection.End(xlToLeft).Select
114
-
115
- Selection.End(xlUp).Select
116
-
117
- Selection.End(xlUp).Select
118
-
119
- Range(Selection, Selection.End(xlToRight)).Select
120
-
121
- Selection.Copy
122
-
123
- Sheets("Sheet5").Select
124
-
125
- Range("A1").Select
126
-
127
- Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
128
-
129
- False, Transpose:=True
130
-
131
- Application.CutCopyMode = False
132
-
133
- Range("A1").Select
134
-
135
- Application.CutCopyMode = False
136
-
137
- Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
138
-
139
- Range("A1").Select
140
-
141
- Range(Selection, Selection.End(xlToRight)).Select
142
-
143
- Selection.AutoFilter
144
-
145
- ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Operator:= _
146
-
147
- xlFilterNoFill
148
-
149
- ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Criteria1:=RGB(255, _
150
-
151
- 255, 0), Operator:=xlFilterCellColor
152
-
153
- ActiveWindow.SmallScroll Down:=-33
154
-
155
- Range("A7").Select
156
-
157
- Range("C8").Select
158
-
159
- ActiveWindow.SmallScroll Down:=-18
160
-
161
- ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Criteria1:=RGB(255, _
162
-
163
- 255, 0), Operator:=xlFilterCellColor
164
-
165
- ActiveWindow.SmallScroll Down:=-15
166
-
167
- Sheets("Sheet4").Select
168
-
169
- ActiveWindow.SmallScroll ToRight:=-30
170
-
171
- Sheets("Sheet5").Select
172
-
173
- Range("A7:A120").Select
174
-
175
- Range("B11").Select
176
-
177
- Sheets("Sheet4").Select
178
-
179
- ActiveWindow.SmallScroll ToRight:=-66
180
-
181
- Range("J3").Select
182
-
183
- Sheets("Sheet5").Select
184
-
185
- Range("A1").Select
186
-
187
- ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1
188
-
189
- Sheets("Sheet4").Select
190
-
191
- Range("A2").Select
192
-
193
- Range(Selection, Selection.End(xlToRight)).Select
194
-
195
- Range(Selection, Selection.End(xlDown)).Select
196
-
197
- Selection.Copy
198
-
199
- Sheets("Sheet5").Select
200
-
201
- Range("B2").Select
202
-
203
- Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
204
-
205
- False, Transpose:=True
206
-
207
- Range("A1").Select
208
-
209
- ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Criteria1:=RGB(255, _
210
-
211
- 255, 0), Operator:=xlFilterCellColor
212
-
213
- Range("A7").Select
214
-
215
- Range(Selection, Selection.End(xlDown)).Select
216
-
217
- Application.CutCopyMode = False
218
-
219
- Selection.EntireRow.Delete
220
-
221
- ActiveSheet.Range("$A$1:$HE$23").AutoFilter Field:=1
222
-
223
- Range("B2").Select
224
-
225
- Range(Selection, Selection.End(xlToRight)).Select
226
-
227
- Range(Selection, Selection.End(xlDown)).Select
228
-
229
- Selection.Copy
230
-
231
- Sheets("Sheet3").Select
232
-
233
- Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
234
-
235
- False, Transpose:=True
236
-
237
- Range("F10").Select
39
+ ☆CSV取り込みマクロ☆
40
+
41
+ Sub openCSV()
42
+
43
+
44
+
45
+ 'CSVの取り込み
46
+
47
+
48
+
49
+ Dim varFileName As Variant
50
+
51
+
52
+
53
+ varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
54
+
55
+ Title:="CSVファイルの選択")
56
+
57
+ If varFileName = False Then
58
+
59
+ Exit Sub
60
+
61
+ End If
62
+
63
+
64
+
65
+ Workbooks.Open Filename:=varFileName
66
+
67
+ ActiveSheet.Cells.Copy ThisWorkbook.ActiveSheet.Cells
68
+
69
+ ActiveWorkbook.Close savechanges:=False
70
+
71
+
72
+
73
+
238
74
 
239
75
  End Sub
240
76
 
77
+
78
+
79
+ ☆データ加工マクロ☆
80
+
81
+ Option Explicit
82
+
83
+
84
+
85
+ Sub ColCopy()
86
+
87
+ Dim xlBook As Workbook 'ワークシートですよ
88
+
89
+ Dim xlSheetOrg As Worksheet 'ワークシートですよ
90
+
91
+ Dim xlSheetSel As Worksheet 'ワークシートですよ
92
+
93
+ Dim xlSheetDst As Worksheet 'ワークシートですよ
94
+
95
+ Dim strDstSheetName As String '文字列ですよ
96
+
97
+ Dim rngLastRow As Range 'セルですよ
98
+
99
+ Dim vntIndex As Variant
100
+
101
+ Dim rngIndexs As Range 'セルですよ
102
+
103
+ Dim rngHeader As Range 'セルですよ
104
+
105
+ Dim lngColSrc As Long '長整数ですよ
106
+
107
+ Dim lngColDst As Long '長整数ですよ
108
+
109
+ Dim rngTargetCol As Range 'セルですよ
110
+
111
+
112
+
113
+
114
+
115
+ Set xlBook = ThisWorkbook
116
+
117
+
118
+
119
+ With xlBook
120
+
121
+ Set xlSheetSel = .Worksheets("列選択")
122
+
123
+ Set xlSheetOrg = .Worksheets("オリジナル")
124
+
125
+ End With
126
+
127
+
128
+
129
+ ' コピー先シート名取得
130
+
131
+ strDstSheetName = xlSheetSel.Range("A3").Value
132
+
133
+
134
+
135
+ ' コピー先シートを初期化（なければ生成）
136
+
137
+ On Error GoTo ERR_DST_SHEET
138
+
139
+ Set xlSheetDst = xlBook.Worksheets(strDstSheetName)
140
+
141
+ With xlSheetDst
142
+
143
+ .Cells.Clear
144
+
145
+ End With
146
+
147
+ On Error GoTo 0
148
+
149
+
150
+
151
+
152
+
153
+ ' 項目名を読み取り
154
+
155
+ With xlSheetSel
156
+
157
+ Set rngLastRow = .Cells(.Rows.Count, 1).End(xlUp) 'A列の一番下取得
158
+
159
+ Set rngIndexs = .Range(.Cells(5, 1), rngLastRow) 'A5~A列一番下まで範囲指定
160
+
161
+ Debug.Print
162
+
163
+ Set rngLastRow = Nothing
164
+
165
+ End With
166
+
167
+
168
+
169
+ ' 見出し行の取り込み
170
+
171
+ Set rngHeader = xlSheetOrg.Rows(1) 'オリジナルシートの1行目取得
172
+
173
+
174
+
175
+ ' 該当列のコピー
176
+
177
+ Application.ScreenUpdating = False
178
+
179
+ With xlSheetDst '新しく作ったシートに
180
+
181
+ lngColDst = 0
182
+
183
+ For Each vntIndex In rngIndexs '指定した範囲分繰り返す
184
+
185
+ lngColDst = lngColDst + 1
186
+
187
+ Set rngTargetCol = rngHeader.Find(CStr(vntIndex)) '(文字列の検索)ヘッダーをセット
188
+
189
+ lngColSrc = rngTargetCol.Column
190
+
191
+ rngTargetCol.EntireColumn.Copy .Cells(1, lngColDst) 'IngColDstの1行目の列全体をコピー
192
+
193
+ Set rngTargetCol = Nothing
194
+
195
+ Next vntIndex
196
+
197
+ Set rngIndexs = Nothing
198
+
199
+ End With
200
+
201
+ Application.ScreenUpdating = True
202
+
203
+
204
+
205
+ GoTo PROC_END
206
+
207
+
208
+
209
+ ERR_DST_SHEET:
210
+
211
+ Set xlSheetDst = Sheets.Add(, Sheets("オリジナル")) 'オリジナルシートの隣に新規シート挿入終わり
212
+
213
+ xlSheetDst.Name = strDstSheetName
214
+
215
+ Resume Next
216
+
217
+
218
+
219
+ PROC_END:
220
+
221
+ Set rngHeader = Nothing
222
+
223
+ Set xlSheetDst = Nothing
224
+
225
+ Set xlSheetOrg = Nothing
226
+
227
+ Set xlSheetSel = Nothing
228
+
229
+ Set xlBook = Nothing
230
+
231
+
232
+
241
- ```
233
+ End Sub
234
+
235
+
236
+
237
+
242
238
 
243
239
 
244
240
 
245
241
  ###試したこと
246
242
 
247
- 作業はマクロの記録で実施。
243
+
248
-
244
+
249
- ①事前にExcel内にタイトル行を作成
245
+ ①CSVをExcelブックで取り込み、タイトルがついてないので、
250
-
251
- ②ExcelにCSVデータを貼り付け
246
+
252
-
253
- ③CSVの不要な列に目印をつける
254
-
255
- ④目印を付けたデータを縦横入れかえて、別シートへ張り付けて、目印でソートをかけ、不要行を削除。
256
-
257
- ⑤加工したデータを事前に作成した、タイトルのあるシートへ縦横入れ替えて張り付ける
258
-
259
-
260
-
261
- 以上の作業をマクロで行いたいです。
247
+ 必要な列にのみタイトルをつけた（これをマクロでやりたい）
248
+
249
+
250
+
251
+
262
252
 
263
253
 
264
254
 

1

実際に行った処理を追記致しました

2017/05/23 06:55

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -12,13 +12,21 @@
12
12
 
13
13
 
14
14
 
15
+ 初心者の為、マクロの記録で作業を行っており
16
+
17
+ コードが無駄に長くなってしまいました
18
+
19
+
20
+
21
+
22
+
15
23
  ###発生している問題・エラーメッセージ
16
24
 
17
25
 
18
26
 
19
27
  ```
20
28
 
21
- エラーメッセージ
29
+
22
30
 
23
31
  ```
24
32
 
@@ -28,7 +36,207 @@
28
36
 
29
37
  ```ここに言語を入力
30
38
 
39
+ Sub Macro2()
40
+
41
+ '
42
+
43
+ ' Macro2 Macro
44
+
45
+ '
46
+
47
+
48
+
49
+ '
50
+
51
+ Range("A2:CB2").Select
52
+
53
+ Range(Selection, Selection.End(xlDown)).Select
54
+
55
+ ActiveWindow.SmallScroll Down:=3
56
+
57
+ Selection.Copy
58
+
59
+ Sheets("Sheet4").Select
60
+
61
+ Range("A2").Select
62
+
63
+ Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
64
+
31
- ここにご自身が実行したソースコードを書いてください
65
+ :=False, Transpose:=False
66
+
67
+ Range("A1").Select
68
+
69
+ Range(Selection, Selection.End(xlToRight)).Select
70
+
71
+ Range("A1:CA1").Select
72
+
73
+ Range(Selection, Selection.End(xlDown)).Select
74
+
75
+ Range("B2:CB2").Select
76
+
77
+ Range(Selection, Selection.End(xlDown)).Select
78
+
79
+ Application.CutCopyMode = False
80
+
81
+ Selection.Copy
82
+
83
+ ActiveWindow.SmallScroll Down:=3
84
+
85
+ Sheets("Sheet5").Select
86
+
87
+ Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
88
+
89
+ False, Transpose:=True
90
+
91
+ Columns("A:A").Select
92
+
93
+ Application.CutCopyMode = False
94
+
95
+ Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
96
+
97
+ Rows("1:1").Select
98
+
99
+ Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
100
+
101
+ Range("A2").Select
102
+
103
+ Sheets("Sheet3").Select
104
+
105
+ ActiveWindow.SmallScroll Down:=-6
106
+
107
+ Sheets("Sheet4").Select
108
+
109
+ ActiveWindow.SmallScroll Down:=-99
110
+
111
+ Range("BF97").Select
112
+
113
+ Selection.End(xlToLeft).Select
114
+
115
+ Selection.End(xlUp).Select
116
+
117
+ Selection.End(xlUp).Select
118
+
119
+ Range(Selection, Selection.End(xlToRight)).Select
120
+
121
+ Selection.Copy
122
+
123
+ Sheets("Sheet5").Select
124
+
125
+ Range("A1").Select
126
+
127
+ Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
128
+
129
+ False, Transpose:=True
130
+
131
+ Application.CutCopyMode = False
132
+
133
+ Range("A1").Select
134
+
135
+ Application.CutCopyMode = False
136
+
137
+ Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
138
+
139
+ Range("A1").Select
140
+
141
+ Range(Selection, Selection.End(xlToRight)).Select
142
+
143
+ Selection.AutoFilter
144
+
145
+ ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Operator:= _
146
+
147
+ xlFilterNoFill
148
+
149
+ ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Criteria1:=RGB(255, _
150
+
151
+ 255, 0), Operator:=xlFilterCellColor
152
+
153
+ ActiveWindow.SmallScroll Down:=-33
154
+
155
+ Range("A7").Select
156
+
157
+ Range("C8").Select
158
+
159
+ ActiveWindow.SmallScroll Down:=-18
160
+
161
+ ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Criteria1:=RGB(255, _
162
+
163
+ 255, 0), Operator:=xlFilterCellColor
164
+
165
+ ActiveWindow.SmallScroll Down:=-15
166
+
167
+ Sheets("Sheet4").Select
168
+
169
+ ActiveWindow.SmallScroll ToRight:=-30
170
+
171
+ Sheets("Sheet5").Select
172
+
173
+ Range("A7:A120").Select
174
+
175
+ Range("B11").Select
176
+
177
+ Sheets("Sheet4").Select
178
+
179
+ ActiveWindow.SmallScroll ToRight:=-66
180
+
181
+ Range("J3").Select
182
+
183
+ Sheets("Sheet5").Select
184
+
185
+ Range("A1").Select
186
+
187
+ ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1
188
+
189
+ Sheets("Sheet4").Select
190
+
191
+ Range("A2").Select
192
+
193
+ Range(Selection, Selection.End(xlToRight)).Select
194
+
195
+ Range(Selection, Selection.End(xlDown)).Select
196
+
197
+ Selection.Copy
198
+
199
+ Sheets("Sheet5").Select
200
+
201
+ Range("B2").Select
202
+
203
+ Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
204
+
205
+ False, Transpose:=True
206
+
207
+ Range("A1").Select
208
+
209
+ ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Criteria1:=RGB(255, _
210
+
211
+ 255, 0), Operator:=xlFilterCellColor
212
+
213
+ Range("A7").Select
214
+
215
+ Range(Selection, Selection.End(xlDown)).Select
216
+
217
+ Application.CutCopyMode = False
218
+
219
+ Selection.EntireRow.Delete
220
+
221
+ ActiveSheet.Range("$A$1:$HE$23").AutoFilter Field:=1
222
+
223
+ Range("B2").Select
224
+
225
+ Range(Selection, Selection.End(xlToRight)).Select
226
+
227
+ Range(Selection, Selection.End(xlDown)).Select
228
+
229
+ Selection.Copy
230
+
231
+ Sheets("Sheet3").Select
232
+
233
+ Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
234
+
235
+ False, Transpose:=True
236
+
237
+ Range("F10").Select
238
+
239
+ End Sub
32
240
 
33
241
  ```
34
242
 
@@ -36,7 +244,21 @@
36
244
 
37
245
  ###試したこと
38
246
 
247
+ 作業はマクロの記録で実施。
248
+
39
- 課題に対してアプローチしたことを記載してください
249
+ ①事前にExcel内にタイトル行を作成
250
+
251
+ ②ExcelにCSVデータを貼り付け
252
+
253
+ ③CSVの不要な列に目印をつける
254
+
255
+ ④目印を付けたデータを縦横入れかえて、別シートへ張り付けて、目印でソートをかけ、不要行を削除。
256
+
257
+ ⑤加工したデータを事前に作成した、タイトルのあるシートへ縦横入れ替えて張り付ける
258
+
259
+
260
+
261
+ 以上の作業をマクロで行いたいです。
40
262
 
41
263
 
42
264