[[20151007100448]]　『VBA_列数可変csvからの抽出』（さいき）　ページの最後に飛ぶ

『VBA_列数可変csvからの抽出』（さいき）

 お世話になっております
 標題の件で教えていただきたく参りました
 最終的にはcsvファイルから必要なデータだけを抽出したいです

 【条件】
 ・元データは12万行超え、13列以上の日時と文字列、空白あり(空白行なし)のcsv
 "でかこまれた,区切りで、14列目以降データのない行は," "," "," "," "でした
 ・必要なのは元データでいう、E/F/Mの3列
 ・抽出したいのは、F列が"E"ではじまり、M列が特定の16桁の数字の羅列
   この16桁の数字の羅列のせいで、インポートにしました
   ダブルクリックで開くと、16桁目が0となり、表示は2.01 E+15になります
 ・このあと、別のExcelファイルのデータと合わせて重複削除を行います

 【質問内容 1】
 ・以下の14列目以降のColumnDataTypesを指定せずに作成したもので大丈夫なんでしょうか？
 ・他によいと思われる方法はないでしょうか？
  他の方法があるのならば知りたいです
 Line Input# や  Get# (？)にすれば早いとの情報をネットで仕入れましたが、質問内容2 の解決におわれ、まだ試せていません

 【質問内容 2】
 直接の操作に関係のない話です
 17列データを18列データにして、下記コードで動くかどうかのテストをしたかった為に起こりました
 (結果的には"で囲まれないデータとなった為、失敗でした)

 フォルダに該当のcsvファイル(Sとします)を保存し、ダブルクリックで開き、最終列に書き込み、上書き(Uとします)しました
 そのUファイルを下記コードでインポート成型したのち、Uファイルを削除(ゴミ箱も空に)
 新たに元の同名ファイル(S)をフォルダに保存したところ、なぜかSの内容ではなく、Uの内容となります
 Sのときにダブルクリックで開くとSの内容で、フォルダにコピーした途端にUの内容となります
 Sで上書きしたのですから、Sの内容で開いてほしいです
 ・なぜでしょうか？ また、回避策はございますでしょうか？
 ※今は、別のフォルダにコピーし、きちんとSの内容で開いております
 が、元のcsvファイルを上書きして運用していこうと思っているので、上書しているのにも関わらず、前データのままだと困ります

 Sub Test()
 Dim TCol As Long
 Dim i As Long
 Dim TempSh As Worksheet

    Set TempSh = ActiveWorkbook.Worksheets.Add
    With TempSh.QueryTables.Add(Connection:= _
        "TEXT;C:\パス\ファイル名.csv", _
            Destination:=Range("$A$1"))

        .TextFileCommaDelimiter = True
        .TextFileColumnDataTypes = Array(9, 9, 9, 9, 1, 1, 9, 9, 9, 9, 9, 9, 2)
        .Refresh BackgroundQuery:=False
    End With

    With TempSh

        TCol = Range("A1").End(xlToRight).Column
        'タイトルがないのでABCで作成
        .Range("A1", Cells(1, TCol)).Insert Shift:=xlDown
        .Range("A1").Value = "A"
        .Range("A1").AutoFill Destination:=Range("A1", Cells(1, TCol)), Type:=xlFillDefault

        '書き出し先、前データ削除
        Sheets("データ").UsedRange.Clear

        'AdvancedFilter ふるいシートに必要内容
        .Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
                        CriteriaRange:=Sheets("ふるい").Range("A1:B2"), _
                        CopyToRange:=Sheets("データ").Range("A1"), _
                        Unique:=False
        .Delete
    End With
 End Sub

よろしくお願いいたします

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

こんにちは

何が質問なのか良く分かりませんが、コード自体はピリオドの欠落が気になります。

Sub Test()

    Dim TCol As Long
    Dim i As Long
    Dim TempSh As Worksheet

    Set TempSh = ActiveWorkbook.Worksheets.Add
    With TempSh.QueryTables.Add(Connection:= _
        "TEXT;C:\パス\ファイル名.csv", _
            Destination:=.Range("$A$1"))

        .TextFileCommaDelimiter = True
        .TextFileColumnDataTypes = Array(9, 9, 9, 9, 1, 1, 9, 9, 9, 9, 9, 9, 2)
        .Refresh BackgroundQuery:=False

        '書き出し先、前データ削除
        Sheets("データ").UsedRange.Clear

        TCol = .Range("A1").End(xlToRight).Column
        'タイトルがないのでABCで作成
        .Range("A1", .Cells(1, TCol)).Insert Shift:=xlDown
        .Range("A1").Value = "A"
        .Range("A1").AutoFill Destination:=.Range("A1", .Cells(1, TCol)), Type:=xlFillDefault

        .Range("A1", .Cells(1, TCol)).Copy Sheets("データ").Range("A1")

        'AdvancedFilter ふるいシートに必要内容
        .Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
                        CriteriaRange:=Sheets("ふるい").Range("A1:B2"), _
                        CopyToRange:=Sheets("データ").Range("A1").CurrentRegion, _
                        Unique:=False

        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
 End Sub

保存する部分のコードが無いですが、結局このコードではダメだったという事なのでしょうか？
（ウッシ） 2015/10/07(水) 14:40

 ウッシさん、ありがとうございます
 >何が質問なのか良く分かりません
 本文内、 【質問内容 1】 【質問内容 2】 となっております

 >ピリオドの欠落
 とりあえずの1部分でのテストで、Worksheets.Addで対象シートはActiveになっていたので、あとまわしにしておりました
 Application.DisplayAlerts = False　も、とりあえずあとで…という事態でした
 手抜きして申し訳ございません

 >保存する部分のコードが無いですが、結局このコードではダメだったという事なのでしょうか？
 未熟なので、一気にコードがかけません。すみません
 とりあえず、csvファイルのインポートと成型のみに焦点をあてたコードとなっておりますので、保存はまだおこなっておりません

 今現在もっている12万行17列になるcsvファイルでは問題なく動きます

 【質問内容 1】の再掲となりますが、19列や20列になった場合でも、ColumnDataTypeを13列目までしか指定していないコードで大丈夫でしょうか？

 これを確認するために、18列目に書き込んだファイルを作ろうとした結果、【質問内容 2】の事態を引き起こしました
 新たな同名ファイルをコピーやドラッグで上書きした場合、その上書きしたファイルではなく、する前のファイルを読みに行くのはなぜでしょうか？

（さいき） 2015/10/07(水) 15:15

こんにちは

まだ分かりません。

【質問内容 1】はコードに書いて試して比較すればいいと思います。

【質問内容 2】はテキストファイルの操作上の事を聞いているのでしょうか？

上書き(Uとします)・・・Uとするなら別名で保存ですよね？

　　新たな同名ファイルをコピーやドラッグで上書きした場合、
　　その上書きしたファイルではなく、する前のファイルを読みに行く
　　のはなぜでしょうか？

これはWindows上の問題？

読みに行くとは、Excelで読みに行くのですか？

（ウッシ） 2015/10/07(水) 15:29

こんにちは

増えた列は読み込んでしまって、必要なA～C列だけフィルタコピーするとか、

Sub Test()

    Dim TCol As Long
    Dim i As Long
    Dim TempSh As Worksheet

    Set TempSh = ActiveWorkbook.Worksheets.Add
    With TempSh.QueryTables.Add(Connection:= _
        "TEXT;X:\My Documents\Book20151007.csv", _
            Destination:=TempSh.Range("$A$1"))
        .TextFileCommaDelimiter = True
        .TextFileColumnDataTypes = Array(9, 9, 9, 9, 1, 1, 9, 9, 9, 9, 9, 9, 2)
        .Refresh BackgroundQuery:=False
    End With
    With TempSh

        '書き出し先、前データ削除
        Sheets("データ").UsedRange.Clear

        'タイトルがないのでABCで作成
        .Range("A1").EntireRow.Insert Shift:=xlDown
        .Range("A1:C1").Value = Array("A", "B", "C")
        Sheets("データ").Range("A1:C1").Value = Array("A", "B", "C")
        Sheets("ふるい").Range("A1").Value = "B"

        'AdvancedFilter ふるいシートに必要内容
        .Range("A1").CurrentRegion.Range("A:C").AdvancedFilter Action:=xlFilterCopy, _
                        CriteriaRange:=Sheets("ふるい").Range("A1:B2"), _
                        CopyToRange:=Sheets("データ").Range("A1").CurrentRegion, _
                        Unique:=False

        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
End Sub

（ウッシ） 2015/10/07(水) 16:12

 ウッシさん　ありがとうございます
 ああ、衝突しました＞＜

 【質問内容 1】に関して
 >コードに書いて試して比較すればいいと思います。
 ダブルクォーテーション囲いカンマ区切り形式で保存の仕方がわからなかったので、Excelで開いて直接書き込んで上書きしました
 結果、ダブルクォーテーションが消え、13列目の16桁の数字の末尾も0となりました＞＜

 そして、【質問内容 2】をする羽目になりましたTT

 本当にすみません
 指定しなかった14列目以降はどういう扱いになるのかさっぱり見当もつきませんので、質問しました
 19列や20列のサンプルファイルが作れてうまくいったとして、それで本当にいいのかわからなかったのです
 ただいま、Line Input に手を出したので、ファイルの作り方は後で調べます…
 Line Input はやいなー…(感想)

 【質問内容 2】に関して
 >Uとするなら別名で保存ですよね？ 
 いいえ。
 便宜上、呼び名(ニックネーム?)をUとSにしただけで、ファイル名は同じです

 新たなファイルで上書きしたのに、上書する前の内容になります

 >読みに行くとは、Excelで読みに行くのですか？ 
 アイコンダブルクリックで開いても、VBAを使わずExcel上の操作でインポートを行っても、前述のコードを実行しても、上書き前のデータ内容になります

 その新たなファイルは特定のフォルダに上書きする前までは新たな内容です
 特定のフォルダに上書きした途端、上書き前のデータに変わります

 上書きがダメなのか? と、一度削除しゴミ箱を空にして、再度新たなファイルを特定のフォルダに入れても、消したはずの内容になります

 >これはWindows上の問題？ 
 そうなんでしょうか？
 まったくわからないので質問しましたTT

 いままで、Excelのファイルは、上書したら、その内容しか見れなかったのですが、csvファイルというものはその限りではないのでしょうか
 それともExcelで開いて入力して上書きしたせいでしょうか

（さいき） 2015/10/07(水) 16:18

 >.Range("A1").CurrentRegion.Range("A:C")
 こんな書き方があるんですね！  感動です！
 さっそく書き換えます！！

 データ型を指定しなかった14列目以降は、なんもしなくても大丈夫だということですね
 安心しました

 が、新たな問題が発生しました
 別トピであげたほうがよいのでしょうか？

 AdvancedFilter でデータ型が文字列で、数字16桁のところに使うと、
 誤差(?)が発生するんでしょうか？
 2015000000258164を抽出しているのですが、2015000000258160まで抽出されます
 Line Inputで抽出した内容が合っているか見ていたところ発覚しました
 今回は1件だけだったので見逃していました…

 以下、Line Inputのコード
 Sub Test2()
    Dim line As String
    Dim sentence As Variant
    Dim i As Long, k As Long

    k = 1

    Open "C:パス\ファイル名.csv" For Input As #1

    Do Until EOF(1)
        Line Input #1, line
        'ダブルクォーテーションとる
        line = Replace(line, """", "")
        'カンマでわける
        sentence = Split(line, ",")

        If Left(sentence(5), 1) = "E" Then
            If sentence(12) = "2015000000258164" Then
              '--のちほど、配列につっこんで一気に書き込みさせる手法へ変更
                Cells(k, 1) = sentence(4)
                Cells(k, 2) = sentence(5)
                k = k + 1
            End If
        End If
    Loop
    Close #1

 '--ExcelファイルをAdvancedFilterで抽出
 '--キーから名前を他のExcelファイルから拾う
 '--このコードでできたファイルと重複削除

End Sub

（さいき） 2015/10/07(水) 16:49

こんにちは

16桁は出来ないみたいですね。
8桁ずつわけてしまうとか・・・

Sub Test()

    Dim TCol As Long
    Dim i As Long
    Dim TempSh As Worksheet

    Set TempSh = ActiveWorkbook.Worksheets.Add
    With TempSh.QueryTables.Add(Connection:= _
        "TEXT;X:\My Documents\Book20151007.csv", _
            Destination:=TempSh.Range("$A$1"))
        .TextFileCommaDelimiter = True
        .TextFileColumnDataTypes = Array(9, 9, 9, 9, 1, 1, 9, 9, 9, 9, 9, 9, 2)
        .Refresh BackgroundQuery:=False
    End With
    With TempSh
        Application.DisplayAlerts = False
        .Columns("C:C").Copy .Range("D1")
        .Columns("D:D").TextToColumns Destination:=.Range("D1"), DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 2), Array(8, 2)), TrailingMinusNumbers:=True
        Application.DisplayAlerts = True

        '書き出し先、前データ削除
        Sheets("データ").UsedRange.Clear

        'タイトルがないのでABCで作成
        .Range("A1").EntireRow.Insert Shift:=xlDown
        .Range("A1:E1").Value = Array("A", "B", "C", "D", "E")
        Sheets("データ").Range("A1:C1").Value = Array("A", "B", "C")
        Sheets("ふるい").Range("A1:C1").Value = Array("B", "D", "E")
        Sheets("ふるい").Range("A2").Value = "A*"
        Sheets("ふるい").Range("B2").Value = "'20150000"
        Sheets("ふるい").Range("C2").Value = "'00258164"

        'AdvancedFilter ふるいシートに必要内容
        .Range("A1").CurrentRegion.Range("A:E").AdvancedFilter Action:=xlFilterCopy, _
                        CriteriaRange:=Sheets("ふるい").Range("A1:C2"), _
                        CopyToRange:=Sheets("データ").Range("A1").CurrentRegion, _
                        Unique:=False

        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
End Sub

（ウッシ） 2015/10/07(水) 17:34

コメント返信：

[ 一覧(最新更新順) ]

[[20151007100448]] 『VBA_列数可変csvからの抽出』（さいき） ページの最後に飛ぶ

[[20151007100448]]　『VBA_列数可変csvからの抽出』（さいき）　ページの最後に飛ぶ