質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.13%

CSVデータのマクロでの取り込み方が分からない

受付中

回答 3

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 4,029

d12345d

score 4

前提・実現したいこと

CSVで出力したデータを必要な列のみ取り出して
Excelのデータに取り込みたい。

その際、用意している定型のタイトル行を加工データに挿入したい。

さらに、別のCSVデータも同Excelに取り込んだ際
重複していないCSVデータのみを最終行へ反映させたい。

発生している問題・エラーメッセージ

①CSVの取り込みマクロを作成したが、単体で作ったためどこに入れればワンクリックでマクロを起動した際、CSV取り込み→表作成と流れるようにマクロが動くのかわからない。
②自分で用意したタイトル行を入れる方法が分からない
③重複しないデータを取り込む方法がわからない

☆データ加工マクロ☆は指定のタイトル列を丸ごとコピーして抽出データシートに張り付けています。

新しい他のデータを同じようにマクロをかけたときに重複するデータを探すキーはA列の申請№で確認したいのですが、作ったマクロを実行すると、列ごとにコピペするようになっているため、そのほかの列は重複が分からず全部のデータを張り付けてしまうためわからなくなっています。
イメージ説明

該当のソースコード

☆CSV取り込みマクロ☆
Sub openCSV()

'CSVの取り込み

Dim varFileName As Variant

varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
Title:="CSVファイルの選択")
If varFileName = False Then
Exit Sub
End If

Workbooks.Open Filename:=varFileName
ActiveSheet.Cells.Copy ThisWorkbook.ActiveSheet.Cells
ActiveWorkbook.Close savechanges:=False

End Sub

☆データ加工マクロ☆
Option Explicit

Sub ColCopy()
Dim xlBook As Workbook    'ワークシートですよ
Dim xlSheetOrg As Worksheet     'ワークシートですよ
Dim xlSheetSel As Worksheet     'ワークシートですよ
Dim xlSheetDst As Worksheet     'ワークシートですよ
Dim strDstSheetName As String       '文字列ですよ
Dim rngLastRow As Range  'セルですよ
Dim vntIndex As Variant
Dim rngIndexs As Range      'セルですよ
Dim rngHeader As Range     'セルですよ
Dim lngColSrc As Long     '長整数ですよ
Dim lngColDst As Long    '長整数ですよ
Dim rngTargetCol As Range     'セルですよ

Set xlBook = ThisWorkbook

With xlBook
Set xlSheetSel = .Worksheets("列選択")
Set xlSheetOrg = .Worksheets("オリジナル")
End With

' コピー先シート名取得
strDstSheetName = xlSheetSel.Range("A3").Value

' コピー先シートを初期化(なければ生成)
On Error GoTo ERR_DST_SHEET
Set xlSheetDst = xlBook.Worksheets(strDstSheetName)
With xlSheetDst
.Cells.Clear
End With
On Error GoTo 0

' 項目名を読み取り
With xlSheetSel
Set rngLastRow = .Cells(.Rows.Count, 1).End(xlUp)    'A列の一番下取得
Set rngIndexs = .Range(.Cells(5, 1), rngLastRow)         'A5~A列一番下まで範囲指定
Debug.Print
Set rngLastRow = Nothing
End With

' 見出し行の取り込み
Set rngHeader = xlSheetOrg.Rows(1)    'オリジナルシートの1行目取得

' 該当列のコピー
Application.ScreenUpdating = False
With xlSheetDst                     '新しく作ったシートに
lngColDst = 0
For Each vntIndex In rngIndexs      '指定した範囲分繰り返す
lngColDst = lngColDst + 1
Set rngTargetCol = rngHeader.Find(CStr(vntIndex))       '(文字列の検索)ヘッダーをセット
lngColSrc = rngTargetCol.Column
rngTargetCol.EntireColumn.Copy .Cells(1, lngColDst)         'IngColDstの1行目の列全体をコピー
Set rngTargetCol = Nothing
Next vntIndex
Set rngIndexs = Nothing
End With
Application.ScreenUpdating = True

GoTo PROC_END

ERR_DST_SHEET:
Set xlSheetDst = Sheets.Add(, Sheets("オリジナル"))         'オリジナルシートの隣に新規シート挿入終わり
xlSheetDst.Name = strDstSheetName
Resume Next

PROC_END:
Set rngHeader = Nothing
Set xlSheetDst = Nothing
Set xlSheetOrg = Nothing
Set xlSheetSel = Nothing
Set xlBook = Nothing

End Sub

試したこと

①CSVをExcelブックで取り込み、タイトルがついてないので、
必要な列にのみタイトルをつけた(これをマクロでやりたい)

補足情報(言語/FW/ツール等のバージョンなど)

Excel2016使用

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • 退会済みユーザー

    2017/05/16 16:12

    複数のユーザーから「やってほしいことだけを記載した丸投げの質問」という意見がありました
    「質問を編集する」ボタンから編集を行い、調査したこと・試したことを記入していただくと、回答が得られやすくなります。

回答 3

+2

自分用に以前作成した、CSV取り込みのひな形と、テスト用のCSVデータをお示しします。
これですぐに解決とはいかないと思いますが、参考にしてみてください。

Sub import_CSV()
'Excelにcsvを取り込むとき用のひな形
    Dim data_path As Variant
    Dim qt As QueryTable
    Dim target_ws As Worksheet
    Dim r As Range

    Set target_ws = ActiveSheet
    target_ws.Activate
'    target_ws.Cells.Clear

'ダイアログからCSVファイルを選択(ダイアログを開く前にこのブックのディレクトリに移動)
    ChDrive (Left(ThisWorkbook.Path, 1))
    ChDir (ThisWorkbook.Path)
    data_path = Application.GetOpenFilename("CSVファイル,*.csv")
    If data_path = False Then
        Worksheets(1).Activate
        Exit Sub
    End If

    Set r = Selection.Cells(1)      '取り込み開始セル
'csv取り込み
    Set qt = target_ws.QueryTables.Add(Connection:="TEXT;" & data_path, Destination:=r)
    With qt
        .TextFilePlatform = 932
        .TextFileParseType = xlDelimited    
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileTabDelimiter = False
        .TextFileCommaDelimiter = True

        .TextFileColumnDataTypes = Array(1, 9, 9, 2, 9, 1)      '列ごとの取り込み形式
'        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)

''        xlGeneralFormat   1    一般形式
''        xlTextFormat      2    テキスト形式
''        xlMDYFormat       3    MDY 日付形式
''        xlDMYFormat       4    DMY 日付形式
''        xlYMDFormat       5    YMD 日付形式
''        xlMYDFormat       6    MYD 日付形式
''        xlDYMFormat       7    DYM 日付形式
''        xlYDMFormat       8    YDM 日付形式
''        xlSkipColumn      9    列は解析されません。(取り込まない)
''        xlEMDFormat      10    EMD 日付形式

        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    qt.Delete
    Set qt = Nothing
End Sub


test.csv-------------------------------
item1,item2,item3,item4,item5,item6
1,1,1,01,1,北海道
2,2,2,02,2,青森県
3,3,3,03,3,岩手県
4,4,4,04,4,宮城県

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

+1

マクロの記録を使用することは良いのですが、まずはその記録したコードを整理し、他者はもとより自分自身が理解できる技術力を身に着けてください。
記録されたコードそのものを提示し、それの修正方法を教えてくださいってのは無茶振りすぎるってもんです。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/05/16 16:37

    消したら動かなくなってしまったので、動いていた時の元データを乗せたのですが、もう一度見直してみます!!ありがとうございます。

    キャンセル

+1

「マクロの記録」は便利な機能ですが、体験されている通り煩雑で無駄に長いコードが生成されます。
理由は、「マクロの記録」では単純に行われた操作をVBAの言葉に置き換えて記録しているだけで、効率化のようなことは考えていないからです。

例えばA1~A10セルに1~10の値を入力する場合、人がプログラミングすれば大抵以下の3行程度のコードで実装でします。

For i = 1 To 10
    Cells(i, "A") = i
Next


でもこれを手入力でセルに入力し、その操作をマクロで記録した場合、まずそれぞれのセルをSelectし、その後セルに値をセットする、という処理が10回繰り返されると思います。

このようにマクロの記録は記録したことをそのままVBA化するだけですので、そのままでは効率も悪く汎用性も低いものになってしまいます。
でも、やろうとしていることがどんな命令で実現できるか?ということを知るには大変便利な機能です。
ですので、ttyp03さんの回答にもあるとおり記録された内容を1行ずつ理解し、応用できるようになることが初心者さんの開発の第一歩になると思います。

面倒ではありますが、がんばってみてください。

参考までに

提示いただいたマクロの冒頭部分を解読すると以下のような処理になっているようです。

    'A2:CB2の範囲を選択
    Range("A2:CB2").Select
    '選択範囲をデータが連続して存在する範囲で下方向に拡張(たぶんCtrl+Shift+↓操作)
    Range(Selection, Selection.End(xlDown)).Select
    '3行スクロール
    ActiveWindow.SmallScroll Down:=3
    '選択範囲をコピー
    Selection.Copy
    'Sheet4に切り替え
    Sheets("Sheet4").Select
    'A2セルを選択
    Range("A2").Select
    'コピーした内容を選択位置に条件を指定して貼り付け
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    ・・・以下略


中盤以降では行・列の挿入やオートフィルタなども行っているようですが、見た限りCSVの取込と思われる部分はなさそうです。


やりたいこと①~⑤をいっぺんに考えると気が遠くなると思いますので、やれそうなものから順番に1つずつクリアしていくことをお勧めします。
がんばってください。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/05/16 18:06

    CSVの取り込み方が分からなかったので、開いたCSVファイルのデータを張り付けてから作業を開始しました。質問と内容がややこしくなってしますみません。回答頂いた内容を踏まえて修正してみます!!丁寧にご教示いただきありがとうございます!!

    キャンセル

  • 2017/05/23 19:38

    修正後の質問内容に対してアドバイスです。

    ①についてはいくつか方法がありますが、よく使われるのはマクロ起動用のボタンを用意する方法だと思います。
    「Excel マクロの起動」のようなキーワードでググればやり方が見つかると思います。
     
    ②については、"列選択"シートに記載している項目名で検索する為、CSVを取り込んだ"オリジナル"シートに見出し列を追加したい、ということでよいでしょうか?
    これであれば、`xlSheetOrg.Rows(1).Insert`で先頭に行挿入できます。
    その後、任意のセルに項目名をセットしてあげればよいでしょう。

    ③について
    今回提示いただいているコードでは、コピー対象列を探して、列単位に出力シートへ貼り付けるものと思います。
    しかし③で実現したい処理は、行単位に重複を確認しながら貼り付ける、といった処理になるはずです。

    今回提示いただいているコードの貼り付け処理を、列単位のループから行単位のループに変更するような仕様の見直しが必要になりそうです。
    もしくはオリジナルのシートからあらかじめ不要なデータを削除しておき、その後残っているデータを貼りつけるという方法も取れそうです。

    ---
    ①②はちょっとがんばればすぐにできそうですね。
    ③は少し難しく感じるかもしれませんが、実際はそれほど難しいものではありません。
    どういう順番でデータを取得して、重複データをどう判断し、どこに貼り付けるか?
    これをきちんと整理してロジックにできれば目的は達せられるものと思います。

    がんばってください。

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.13%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる