teratail header banner
teratail header banner
質問するログイン新規登録

質問編集履歴

3

イメージ挿入

2017/05/23 07:22

投稿

退会済みユーザー
title CHANGED
File without changes
body CHANGED
@@ -16,6 +16,10 @@
16
16
  ②自分で用意したタイトル行を入れる方法が分からない
17
17
  ③重複しないデータを取り込む方法がわからない
18
18
 
19
+ ☆データ加工マクロ☆は指定のタイトル列を丸ごとコピーして抽出データシートに張り付けています。
20
+
21
+ 新しい他のデータを同じようにマクロをかけたときに重複するデータを探すキーはA列の申請№で確認したいのですが、作ったマクロを実行すると、列ごとにコピペするようになっているため、そのほかの列は重複が分からず全部のデータを張り付けてしまうためわからなくなっています。
22
+ ![イメージ説明](8306e1c6dc59d3e5e0d82e37bdcb57bd.jpeg)
19
23
  ###該当のソースコード
20
24
  ☆CSV取り込みマクロ☆
21
25
  Sub openCSV()

2

作成マクロの更新

2017/05/23 07:22

投稿

退会済みユーザー
title CHANGED
File without changes
body CHANGED
@@ -1,134 +1,129 @@
1
1
  ###前提・実現したいこと
2
2
  CSVで出力したデータを必要な列のみ取り出して
3
- 見出しを付けたExcelのデータに取り込みたい。
3
+ Excelのデータに取り込みたい。
4
4
 
5
+ その際、用意している定型のタイトル行を加工データに挿入したい。
6
+
5
7
  さらに、別のCSVデータも同Excelに取り込んだ際
6
8
  重複していないCSVデータのみを最終行へ反映させたい。
7
9
 
8
- 初心者の為、マクロの記録で作業を行っており
9
- コードが無駄に長くなってしまいました
10
10
 
11
11
 
12
+
12
13
  ###発生している問題・エラーメッセージ
13
14
 
15
+ ①CSVの取り込みマクロを作成したが、単体で作ったためどこに入れればワンクリックでマクロを起動した際、CSV取り込み→表作成と流れるようにマクロが動くのかわからない。
16
+ ②自分で用意したタイトル行を入れる方法が分からない
14
- ```
17
+ ③重複しないデータを取り込む方法がわからない
15
18
 
16
- ```
17
-
18
19
  ###該当のソースコード
19
- ```ここに言語を入力
20
+ ☆CSV取り込みマクロ☆
20
- Sub Macro2()
21
+ Sub openCSV()
21
- '
22
- ' Macro2 Macro
23
- '
24
22
 
25
- '
23
+ 'CSVの取り込み
26
- Range("A2:CB2").Select
24
+
27
- Range(Selection, Selection.End(xlDown)).Select
28
- ActiveWindow.SmallScroll Down:=3
25
+ Dim varFileName As Variant
26
+
29
- Selection.Copy
27
+ varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
30
- Sheets("Sheet4").Select
28
+ Title:="CSVファイルの選択")
31
- Range("A2").Select
32
- Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
33
- :=False, Transpose:=False
29
+ If varFileName = False Then
34
- Range("A1").Select
35
- Range(Selection, Selection.End(xlToRight)).Select
36
- Range("A1:CA1").Select
37
- Range(Selection, Selection.End(xlDown)).Select
38
- Range("B2:CB2").Select
39
- Range(Selection, Selection.End(xlDown)).Select
40
- Application.CutCopyMode = False
41
- Selection.Copy
42
- ActiveWindow.SmallScroll Down:=3
43
- Sheets("Sheet5").Select
44
- Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
45
- False, Transpose:=True
46
- Columns("A:A").Select
47
- Application.CutCopyMode = False
48
- Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
49
- Rows("1:1").Select
50
- Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
51
- Range("A2").Select
52
- Sheets("Sheet3").Select
53
- ActiveWindow.SmallScroll Down:=-6
54
- Sheets("Sheet4").Select
55
- ActiveWindow.SmallScroll Down:=-99
56
- Range("BF97").Select
57
- Selection.End(xlToLeft).Select
58
- Selection.End(xlUp).Select
59
- Selection.End(xlUp).Select
60
- Range(Selection, Selection.End(xlToRight)).Select
61
- Selection.Copy
62
- Sheets("Sheet5").Select
63
- Range("A1").Select
64
- Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
65
- False, Transpose:=True
66
- Application.CutCopyMode = False
67
- Range("A1").Select
68
- Application.CutCopyMode = False
69
- Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
70
- Range("A1").Select
71
- Range(Selection, Selection.End(xlToRight)).Select
72
- Selection.AutoFilter
73
- ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Operator:= _
74
- xlFilterNoFill
30
+ Exit Sub
75
- ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Criteria1:=RGB(255, _
31
+ End If
32
+
76
- 255, 0), Operator:=xlFilterCellColor
33
+ Workbooks.Open Filename:=varFileName
77
- ActiveWindow.SmallScroll Down:=-33
78
- Range("A7").Select
79
- Range("C8").Select
80
- ActiveWindow.SmallScroll Down:=-18
81
- ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Criteria1:=RGB(255, _
82
- 255, 0), Operator:=xlFilterCellColor
83
- ActiveWindow.SmallScroll Down:=-15
84
- Sheets("Sheet4").Select
85
- ActiveWindow.SmallScroll ToRight:=-30
86
- Sheets("Sheet5").Select
87
- Range("A7:A120").Select
88
- Range("B11").Select
89
- Sheets("Sheet4").Select
90
- ActiveWindow.SmallScroll ToRight:=-66
91
- Range("J3").Select
92
- Sheets("Sheet5").Select
93
- Range("A1").Select
94
- ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1
95
- Sheets("Sheet4").Select
96
- Range("A2").Select
97
- Range(Selection, Selection.End(xlToRight)).Select
98
- Range(Selection, Selection.End(xlDown)).Select
99
- Selection.Copy
100
- Sheets("Sheet5").Select
101
- Range("B2").Select
102
- Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
103
- False, Transpose:=True
104
- Range("A1").Select
105
- ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Criteria1:=RGB(255, _
106
- 255, 0), Operator:=xlFilterCellColor
107
- Range("A7").Select
108
- Range(Selection, Selection.End(xlDown)).Select
109
- Application.CutCopyMode = False
110
- Selection.EntireRow.Delete
111
- ActiveSheet.Range("$A$1:$HE$23").AutoFilter Field:=1
34
+ ActiveSheet.Cells.Copy ThisWorkbook.ActiveSheet.Cells
112
- Range("B2").Select
113
- Range(Selection, Selection.End(xlToRight)).Select
35
+ ActiveWorkbook.Close savechanges:=False
114
- Range(Selection, Selection.End(xlDown)).Select
36
+
115
- Selection.Copy
37
+
116
- Sheets("Sheet3").Select
117
- Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
118
- False, Transpose:=True
119
- Range("F10").Select
120
38
  End Sub
121
- ```
122
39
 
40
+ ☆データ加工マクロ☆
41
+ Option Explicit
42
+
43
+ Sub ColCopy()
44
+ Dim xlBook As Workbook 'ワークシートですよ
45
+ Dim xlSheetOrg As Worksheet 'ワークシートですよ
46
+ Dim xlSheetSel As Worksheet 'ワークシートですよ
47
+ Dim xlSheetDst As Worksheet 'ワークシートですよ
48
+ Dim strDstSheetName As String '文字列ですよ
49
+ Dim rngLastRow As Range 'セルですよ
50
+ Dim vntIndex As Variant
51
+ Dim rngIndexs As Range 'セルですよ
52
+ Dim rngHeader As Range 'セルですよ
53
+ Dim lngColSrc As Long '長整数ですよ
54
+ Dim lngColDst As Long '長整数ですよ
55
+ Dim rngTargetCol As Range 'セルですよ
56
+
57
+
58
+ Set xlBook = ThisWorkbook
59
+
60
+ With xlBook
61
+ Set xlSheetSel = .Worksheets("列選択")
62
+ Set xlSheetOrg = .Worksheets("オリジナル")
63
+ End With
64
+
65
+ ' コピー先シート名取得
66
+ strDstSheetName = xlSheetSel.Range("A3").Value
67
+
68
+ ' コピー先シートを初期化(なければ生成)
69
+ On Error GoTo ERR_DST_SHEET
70
+ Set xlSheetDst = xlBook.Worksheets(strDstSheetName)
71
+ With xlSheetDst
72
+ .Cells.Clear
73
+ End With
74
+ On Error GoTo 0
75
+
76
+
77
+ ' 項目名を読み取り
78
+ With xlSheetSel
79
+ Set rngLastRow = .Cells(.Rows.Count, 1).End(xlUp) 'A列の一番下取得
80
+ Set rngIndexs = .Range(.Cells(5, 1), rngLastRow) 'A5~A列一番下まで範囲指定
81
+ Debug.Print
82
+ Set rngLastRow = Nothing
83
+ End With
84
+
85
+ ' 見出し行の取り込み
86
+ Set rngHeader = xlSheetOrg.Rows(1) 'オリジナルシートの1行目取得
87
+
88
+ ' 該当列のコピー
89
+ Application.ScreenUpdating = False
90
+ With xlSheetDst '新しく作ったシートに
91
+ lngColDst = 0
92
+ For Each vntIndex In rngIndexs '指定した範囲分繰り返す
93
+ lngColDst = lngColDst + 1
94
+ Set rngTargetCol = rngHeader.Find(CStr(vntIndex)) '(文字列の検索)ヘッダーをセット
95
+ lngColSrc = rngTargetCol.Column
96
+ rngTargetCol.EntireColumn.Copy .Cells(1, lngColDst) 'IngColDstの1行目の列全体をコピー
97
+ Set rngTargetCol = Nothing
98
+ Next vntIndex
99
+ Set rngIndexs = Nothing
100
+ End With
101
+ Application.ScreenUpdating = True
102
+
103
+ GoTo PROC_END
104
+
105
+ ERR_DST_SHEET:
106
+ Set xlSheetDst = Sheets.Add(, Sheets("オリジナル")) 'オリジナルシートの隣に新規シート挿入終わり
107
+ xlSheetDst.Name = strDstSheetName
108
+ Resume Next
109
+
110
+ PROC_END:
111
+ Set rngHeader = Nothing
112
+ Set xlSheetDst = Nothing
113
+ Set xlSheetOrg = Nothing
114
+ Set xlSheetSel = Nothing
115
+ Set xlBook = Nothing
116
+
117
+ End Sub
118
+
119
+
120
+
123
121
  ###試したこと
124
- 作業はマクロの記録で実施。
125
- ①事前にExcel内にタイトル行を作成
126
- ②ExcelにCSVデータを貼り付け
127
- ③CSVの不要な列に目印をつける
128
- ④目印を付けたデータを縦横入れかえて、別シートへ張り付けて、目印でソートをかけ、不要行を削除。
129
- ⑤加工したデータを事前に作成した、タイトルのあるシートへ縦横入れ替えて張り付ける
130
122
 
123
+ ①CSVをExcelブックで取り込み、タイトルがついてないので、
131
- 以上作業をマクロで行いたいです。
124
+ 必要な列にみタイトルつけた(これをマクロでやりたい
132
125
 
126
+
127
+
133
128
  ###補足情報(言語/FW/ツール等のバージョンなど)
134
129
  Excel2016使用

1

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

2017/05/23 06:55

投稿

退会済みユーザー
title CHANGED
File without changes
body CHANGED
@@ -5,19 +5,130 @@
5
5
  さらに、別のCSVデータも同Excelに取り込んだ際
6
6
  重複していないCSVデータのみを最終行へ反映させたい。
7
7
 
8
+ 初心者の為、マクロの記録で作業を行っており
9
+ コードが無駄に長くなってしまいました
10
+
11
+
8
12
  ###発生している問題・エラーメッセージ
9
13
 
10
14
  ```
11
- エラーメッセージ
15
+
12
16
  ```
13
17
 
14
18
  ###該当のソースコード
15
19
  ```ここに言語を入力
20
+ Sub Macro2()
21
+ '
22
+ ' Macro2 Macro
23
+ '
24
+
25
+ '
26
+ Range("A2:CB2").Select
27
+ Range(Selection, Selection.End(xlDown)).Select
28
+ ActiveWindow.SmallScroll Down:=3
29
+ Selection.Copy
30
+ Sheets("Sheet4").Select
31
+ Range("A2").Select
32
+ Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
16
- ここにご自身が実行したソースコードを書いてください
33
+ :=False, Transpose:=False
34
+ Range("A1").Select
35
+ Range(Selection, Selection.End(xlToRight)).Select
36
+ Range("A1:CA1").Select
37
+ Range(Selection, Selection.End(xlDown)).Select
38
+ Range("B2:CB2").Select
39
+ Range(Selection, Selection.End(xlDown)).Select
40
+ Application.CutCopyMode = False
41
+ Selection.Copy
42
+ ActiveWindow.SmallScroll Down:=3
43
+ Sheets("Sheet5").Select
44
+ Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
45
+ False, Transpose:=True
46
+ Columns("A:A").Select
47
+ Application.CutCopyMode = False
48
+ Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
49
+ Rows("1:1").Select
50
+ Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
51
+ Range("A2").Select
52
+ Sheets("Sheet3").Select
53
+ ActiveWindow.SmallScroll Down:=-6
54
+ Sheets("Sheet4").Select
55
+ ActiveWindow.SmallScroll Down:=-99
56
+ Range("BF97").Select
57
+ Selection.End(xlToLeft).Select
58
+ Selection.End(xlUp).Select
59
+ Selection.End(xlUp).Select
60
+ Range(Selection, Selection.End(xlToRight)).Select
61
+ Selection.Copy
62
+ Sheets("Sheet5").Select
63
+ Range("A1").Select
64
+ Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
65
+ False, Transpose:=True
66
+ Application.CutCopyMode = False
67
+ Range("A1").Select
68
+ Application.CutCopyMode = False
69
+ Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
70
+ Range("A1").Select
71
+ Range(Selection, Selection.End(xlToRight)).Select
72
+ Selection.AutoFilter
73
+ ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Operator:= _
74
+ xlFilterNoFill
75
+ ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Criteria1:=RGB(255, _
76
+ 255, 0), Operator:=xlFilterCellColor
77
+ ActiveWindow.SmallScroll Down:=-33
78
+ Range("A7").Select
79
+ Range("C8").Select
80
+ ActiveWindow.SmallScroll Down:=-18
81
+ ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Criteria1:=RGB(255, _
82
+ 255, 0), Operator:=xlFilterCellColor
83
+ ActiveWindow.SmallScroll Down:=-15
84
+ Sheets("Sheet4").Select
85
+ ActiveWindow.SmallScroll ToRight:=-30
86
+ Sheets("Sheet5").Select
87
+ Range("A7:A120").Select
88
+ Range("B11").Select
89
+ Sheets("Sheet4").Select
90
+ ActiveWindow.SmallScroll ToRight:=-66
91
+ Range("J3").Select
92
+ Sheets("Sheet5").Select
93
+ Range("A1").Select
94
+ ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1
95
+ Sheets("Sheet4").Select
96
+ Range("A2").Select
97
+ Range(Selection, Selection.End(xlToRight)).Select
98
+ Range(Selection, Selection.End(xlDown)).Select
99
+ Selection.Copy
100
+ Sheets("Sheet5").Select
101
+ Range("B2").Select
102
+ Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
103
+ False, Transpose:=True
104
+ Range("A1").Select
105
+ ActiveSheet.Range("$A$1:$HE$122").AutoFilter Field:=1, Criteria1:=RGB(255, _
106
+ 255, 0), Operator:=xlFilterCellColor
107
+ Range("A7").Select
108
+ Range(Selection, Selection.End(xlDown)).Select
109
+ Application.CutCopyMode = False
110
+ Selection.EntireRow.Delete
111
+ ActiveSheet.Range("$A$1:$HE$23").AutoFilter Field:=1
112
+ Range("B2").Select
113
+ Range(Selection, Selection.End(xlToRight)).Select
114
+ Range(Selection, Selection.End(xlDown)).Select
115
+ Selection.Copy
116
+ Sheets("Sheet3").Select
117
+ Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
118
+ False, Transpose:=True
119
+ Range("F10").Select
120
+ End Sub
17
121
  ```
18
122
 
19
123
  ###試したこと
124
+ 作業はマクロの記録で実施。
20
- 課題対してアプローチしたこと記載してください
125
+ ①事前Excel内にタイトル行作成
126
+ ②ExcelにCSVデータを貼り付け
127
+ ③CSVの不要な列に目印をつける
128
+ ④目印を付けたデータを縦横入れかえて、別シートへ張り付けて、目印でソートをかけ、不要行を削除。
129
+ ⑤加工したデータを事前に作成した、タイトルのあるシートへ縦横入れ替えて張り付ける
21
130
 
131
+ 以上の作業をマクロで行いたいです。
132
+
22
133
  ###補足情報(言語/FW/ツール等のバージョンなど)
23
134
  Excel2016使用