[[20150728193143]]　『csvファイル読み込み』（ｖ）　ページの最後に飛ぶ

『csvファイル読み込み』（ｖ）

Excelの日報に、ある測定データのcsvファイルを読み込みたいと考えています。
csvファイル名が特定されている場合はマクロの自動記録から出来ることはわかりましたが、実際にはファイルを選んで読み込みたいためそのためにはどうしたらいいかよくわからないため質問させていただきます。

具体的には、まず日付ごとに日報シートがあり、各日付分のDataシートを作ってそこにファイルを読み込みたいと考えています。
やりたいことの流れとしては
・各日報シートに設置した挿入ボタンを押すとネットワーク上にあるデータフォルダにダイアログボックスからアクセスし、対象のファイルを選んで挿入。
（そのシート名の日付から「27.07.28Data」というようなシート名で挿入）
・複数ファイルを挿入する場合は前のデータの終わりから2行くらい開けて同じシートに続けて挿入。
という感じになります。

まだまだ説明不十分かもしれませんがアドバイス等頂けたら幸いです。
よろしくお願いします。

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

読み込むCSVファイルの指定は、
GetOpenFilename メソッドを使ってはいかがでしょうか。
ヘルプやネット上を検索してみては？

また、csvファイルの読み込みは、
データ　ー　外部データの取込ーテキストファイルの動作をマクロ記録しましょう。
（γ） 2015/07/28(火) 22:09

回答ありがとうございます。
いろいろ調べてなんとか近い動作までは出来るようになりました。
　　Dim varFileName As Variant

    Dim sName As String
    sName = ActiveSheet.Name
    varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
                                        Title:="CSVファイルの選択")
      ActiveWorkbook.Worksheets.Add
    If varFileName = False Then
        Exit Sub
    End If

    With ActiveSheet.QueryTables.Add(Connection:="text;" & varFileName, Destination:=Range("$A$1"))

        .Name = "temp"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    ActiveSheet.Name = sName & "Data"
End Sub

コードはこんな感じですがデータのあるフォルダまでのアドレスを指定してデフォルトのフォルダの位置を変えたいのですがどこを変えたらいいでしょうか？
またデータを追加する場合のコードも追加しないといけないのですが
n = Cells(Rows.Count, "B").End(xlUp).Row + 2
な感じのを使う方法でいいのでしょうか？

（ｖ） 2015/07/29(水) 00:24

http://officetanaka.net/other/extra/tips15.htm
にある方法で、カレントフォルダを変更してから
Application.GetOpenFilename　を実行すればよかったのかな、
未確認ですが。
（カレントフォルダを変更して支障があるようなら、
　現在のものを変数に保持しておいて、作業終了後に元に戻しておきます。）

後半は、
Destination:=Cells(Rows.Count, "B").End(xlUp).Offset(2)
とかですか？

（γ） 2015/07/29(水) 05:38

コードは次のようにしてみました。

 Dim varFileName As Variant
    Dim sName As String
    Dim xWsheet As Worksheet
    Dim xFlag As Boolean

    sName = ActiveSheet.Name
    For Each xWsheet In Worksheets
    If xWsheet.Name = sName & "Data" Then xFlag = True
Next xWsheet
If xFlag = True Then
With CreateObject("WScript.Shell")
    .CurrentDirectory = "C:\Users\T\OneDrive\Documents\MSetting"
    End With
    varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
                                        Title:="CSVファイルの選択")

    If varFileName = False Then
        Exit Sub
    End If

With ActiveSheet.QueryTables.Add(Connection:="text;" & varFileName, Destination:=Cells(Rows.Count, "A").End(xlUp).Offset(2))

        .Name = "temp"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
Else
    With CreateObject("WScript.Shell")
    .CurrentDirectory = "C:\Users\T\OneDrive\Documents\MSetting"
    End With
    varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
                                        Title:="CSVファイルの選択")

    If varFileName = False Then
        Exit Sub
    End If
ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:="text;" & varFileName, Destination:=Range("$A$1"))

        .Name = "temp"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    ActiveSheet.Name = sName & "Data"
    End If
End Sub

「With ActiveSheet.QueryTables.Add(Connection:="text;" & varFileName, Destination:=Cells(Rows.Count, "A").End(xlUp).Offset(2))」の部分でActiveSheetがいけないのかと思うのですが、このままだとデータシートではなく日報シートの方に追加されてしまいます。
すでにデータシートがある場合、データシートの前のデータの後に追加するにはどうしたらいいでしょうか？

（ｖ） 2015/07/30(木) 00:35

 おじゃまします。

 >    sName = ActiveSheet.Name
 >    For Each xWsheet In Worksheets
 >        If xWsheet.Name = sName & "Data" Then xFlag = True
 >    Next xWsheet
 >    If xFlag = True Then

 この部分ですが、どういう処理を意図しているのか、 教えてもらえませんか？

  sName に現在アクティブなシートの名前を代入していますが、ActiveSheet名は 例えばどんなシート名
 ですか？
 > （そのシート名の日付から「27.07.28Data」というようなシート名で挿入） 
  ということからすると、たとえば「27.07.28」というようなシートがアクティブになっているのですか？

 仮にそうだとすると、
 >    For Each xWsheet In Worksheets
 >        If xWsheet.Name = sName & "Data" Then xFlag = True
 >    Next xWsheet
 のところは、ActiveSheetの名前のお尻に "Data" がついた 「27.07.28Data」というようなシート があれば
 フラグを立てる、という処理をしているのですか？

 仮に、そうだとすると、

If xFlag = True Then

  は 「27.07.28Data」というシートがすでにあった、というときの処理を書くことになります。
  すでに書き込むシートが存在したときの処理は、
   (1) その「27.07.28Data」シートをアクティブにすること
   (2) CSVデータの書き込み位置を 既存データの最終行より２行下と指定すること
 ではないでしょうか？

Else

  のときの処理は？
   (1) 「27.07.28Data」シートがないのであれば、まず作成しなければいけないですね？
   (2) 読み込むCSVデータの書きだし先頭位置は 「27.07.28Data」シートの [A1]でいいですね？
 .
（kanabun） 2015/07/30(木) 10:36

 上で仮定したとおりだとすると、こんな感じかな？
 （QueryTable... を２回書く必要はないですよ）

 Sub test2b()
    Dim varFileName As Variant
    Dim xWsheet As Worksheet
    Dim sName As String
    Dim DataSheetName As String
    Dim xFlag As Boolean

    'CSVファイルを選択
    With CreateObject("WScript.Shell")
        .CurrentDirectory = "C:\Users\T\OneDrive\Documents\MSetting"
    End With
    varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル,*.csv", Title:="CSVファイルの選択")
    If varFileName = False Then Exit Sub

    'CSVデータを書き込むシートの確認（なければ作成）
    sName = ActiveSheet.Name
    DataSheetName = sName & "Data"
    For Each xWsheet In Worksheets
        If xWsheet.Name = DataSheetName Then xFlag = True: Exit For
    Next xWsheet

    Dim WriteCell As Range
    If xFlag = True Then '書き込むシートがすでにあったとき
        With Worksheets(DataSheetName)
            .Activate
            Set WriteCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(2)
        End With
    Else
        Worksheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = DataSheetName
        Set WriteCell = Range("A1")
    End If

    With ActiveSheet.QueryTables.Add( _
          Connection:="text;" & varFileName, _
          Destination:=WriteCell)
        .Name = "temp"
        .FieldNames = xFlag  'True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        .Delete  '★ CSVファイルとの接続解除

    End With

 End Sub
 .   
（kanabun） 2015/07/30(木) 10:54

回答ありがとうございます。
kanabunさんに書いていただいたコードでやりたいことがすべてうまく動作できました。
27.07.28という日付の入ったシートにデータを読み込むボタンを設置して、その日付＋Dataシート名を挿入するという形のため、ActiveSheetは日付のシートになりますね。
またDataシートをActivateにして挿入する動作をさせればよかったんですね。
色々勉強になりました。
VBEは初心者でまだまだ理解できていない部分も多いですがもっと勉強していきたいと思います。
ありがとうございました。

（ｖ） 2015/07/30(木) 19:10

(kanabun)様ありがとうございました。

ちょっと投稿する間が空いてしまいました。

＞ネットワーク上にあるデータフォルダに
ということで、CurrentDirectory などの手法をコメントしましたが、
ネットワーク上でうまくいったでしょうか。

単に投稿上の都合でなく、ローカルのファイルだったのであれば、
普通に、ChDrive ，ChDirを使うところですね。

なお、きちんとインデントを付けることをもう少し徹底されたほうがいいです。
そして、適切なコメントをつけてください。
コーディングという観点からは、「将来の自分は他人」ですから。

（γ） 2015/07/30(木) 20:56

コメント返信：

[ 一覧(最新更新順) ]

[[20150728193143]] 『csvファイル読み込み』（ｖ） ページの最後に飛ぶ

[[20150728193143]]　『csvファイル読み込み』（ｖ）　ページの最後に飛ぶ