[[20141129001641]]　『ループしない』（minoru）　ページの最後に飛ぶ

『ループしない』（minoru）

いつもお世話になります。
マクロがループしないcsvデータがあります、原因が判りませんは？
下記はコードの一部ですが、csvデータを取込後の動作で、a.csv
の抽出は期待通りの動作でデータの抽出ができますが、b.csvの抽
出は１行目を読込、出力後にループを抜けてしまい１行目しかデー
タ抽出できません。
a.csv取込時は正常な動作をしますので、b.csvのデータの並びが
ループしない原因と思っているのです何が原因かご教示お願いします。

a.csvもb.csvもマクロのエラーは発生しません。

コードの一部
Do While Not EOF(io)

        Line Input #io, ss            '元データの1行目から読込
        v = Split(ss, ",")            '読込行を,で分割 Vに格納
        ReDim s(1 To 8) As String     '1-8列を繰り返し
          s(1) = v(3)
          s(2) = v(6)
          s(3) = v(12)
          s(4) = v(15)
          s(5) = v(27)
          s(6) = v(70)
          s(7) = v(71)
          s(8) = v(74)
          y = y + 1                    '行カウンタ

        Cells(y, 1).Resize(, 8).Value = s    'マクロを登録したｼｰﾄへ一行分抽出
    Loop

    Close io

＜使用 Excel：Excel2003、使用 OS：WindowsXP ＞

 マクロのどこかに On Error Resume Next があったらこれを外して動かしてみてください。
 エラーが表示されるのではないでしょうか。

 エラーの出る列では、74以下の項目になっていたりしないでしょうか。

 本論と関係ありませんが、
        ReDim s(1 To 8) As String     '1-8列を繰り返し
 をループの中でやる必要はないように見えます。
（Mook） 2014/11/29(土) 01:06

Mook様

お世話になります、返信ありがとうございます。

下記がマクロの全文ですが、On Errorは記載されておりません。
a.csvはＨＳ列が最終列、b.csvはＣＡ列が最終列で、
ともに途中に見出しのみ記載されていて、データは空白の列が
あります。

a.csvの取込時は指定列の最終行までデータが抽出でき、
b.csvの取込時は指定列の１行目のデータのみ抽出して
ループせずにエラーなく終了してしまいます。

このコードはこちらでお世話になり作成していただいたコードで
順調に動作しておりますが、
ReDim s(1 To 8) As String・・・・正確に理解しておりません。

よろしくお願いします。

マクロの全文は以下の通りです。

Sub 取込()

    'デスクトップに \取込\ フォルダがあれば移動する（なければ Currentディレクトリは移動しない）
    Dim myFile
    Dim myPath As String
    myPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\取込\"
    If CreateObject("Scripting.FileSystemObject").FolderExists(myPath) Then
        ChDrive myPath
        ChDir myPath
    End If

   'ファイル選択
    myFile = Application.GetOpenFilename("CSV,*.csv", Title:="CSVファイルを選択")
    If VarType(myFile) = vbBoolean Then Exit Sub
    myPath = Left$(myFile, InStrRev(myFile, "\"))

    Dim io As Integer
    io = FreeFile()
    Open myFile For Input As io

    Dim ss As String
    Dim y As Long
    Dim v

    Do While Not EOF(io)
        Line Input #io, ss            '元データの1行目から読込
        v = Split(ss, ",")            '読込行を,で分割 Vに格納
        ReDim s(1 To 8) As String     '1-8列を繰り返し
          s(1) = v(3)
          s(2) = v(6)
          s(3) = v(12)
          s(4) = v(15)
          s(5) = v(27)
          s(6) = v(70)
          s(7) = v(71)
          s(8) = v(74)
          y = y + 1                    '行カウンタ
         Cells(y, 1).Resize(, 8).Value = s    'マクロを登録したｼｰﾄへ一行分抽出
    Loop

    Close io

 End Sub

（minoru） 2014/11/29(土) 03:10

 前スレは
[[20141116094527]]

 > b.csvの取込時は指定列の１行目のデータのみ抽出して 
 > ループせずにエラーなく終了してしまいます。

 b.csv をメモ帳などで開いて確認してみてください。
 何行ありますか？
 . 
（kanabun） 2014/11/29(土) 09:11

kanabun 様

お世話になります、返信ありがとうございます。
a.csvは50行程度ですが、b.csvは10,000行以上あります。

追加の情報として、
外部データの取込のテキストウイザードでファイルを見比べました。
a.csvは、文字や数値が　text1,text2,text3　となっており
b.csvは、文字や数値が "text1","text2","text3"となっています。

またウイザードで最終列をデータ―のプレビューで見比べると、
a.csvは、右枠いっぱいまでで表示されますが
b.csvは、最終列の右に縦の区切り線が表示されていません。

また、コードを

 s(8) = v(74)
 s(9) = v(78)
          y = y + 1                    
         Cells(y, 1).Resize(, 9).Value = s    
    Loop
上記のように変更したところ、
b.csvのCA1の値とA2の値が、マクロ実行シートのI1セルに２段で表示されました。

改行の何かが原因？？と推測しておりますが、問題解決には知識不足ですので、
先週に続きよろしくお願いします。

（minoru） 2014/11/29(土) 10:30

 > 追加の情報として、 
 > 外部データの取込のテキストウイザードでファイルを見比べました。 
 > a.csvは、文字や数値が　text1,text2,text3　となっており 
 > b.csvは、文字や数値が "text1","text2","text3"となっています。

 b.csv は a.csv とは出力方法がちがいますけど、これはどこで作成した
 テキストファイルなのでしょう？

 > またウイザードで最終列をデータ―のプレビューで見比べると、 
 > a.csvは、右枠いっぱいまでで表示されますが 
 > b.csvは、最終列の右に縦の区切り線が表示されていません。

 上と関係しますが、改行コードが Windows既定の vbCrLf でない可能性が
 あります。もしそうだとすると、Line Input#ステートメントでは 改行を
 認識できませんので、（実際に1万行あったとしても）すべてを一行として
 読み込んでしまいます。

 > 改行の何かが原因？？と推測しておりますが、

 おっしゃるとおりです。たとえば、Unix系のサーバーから全データに " " を付して
 出力したファイルだとか？ そのばあいは 改行コードが vbLF だけなので、
 Line Input # では 行で区切って読むことができません。
 改行コードが vbCrLf か vbLf か はたまた 何か？ ...調べることができますか？
 . 
（kanabun） 2014/11/29(土) 10:47

 10,000行あっても 改行コードを含めてバイナリで一括読み込んでから、その改行コードで
 行に Splitするサンプルです。

 '// 改行コードが vbLf のばあい
 Sub 取込LF()
    'デスクトップに \取込\ フォルダがあれば移動する
    '    （なければ Currentディレクトリは移動しない）
    Dim myFile
    Dim myPath As String
    myPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\取込\"
    If CreateObject("Scripting.FileSystemObject").FolderExists(myPath) Then
        ChDrive myPath
        ChDir myPath
    End If
   'ファイル選択
    myFile = Application.GetOpenFilename("CSV,*.csv", Title:="CSVファイルを選択")
    If VarType(myFile) = vbBoolean Then Exit Sub
    myPath = Left$(myFile, InStrRev(myFile, "\"))

    Dim io As Integer
    Dim vv, v
    Dim buf() As Byte
    Dim ss As String
    Dim y As Long, i As Long

    io = FreeFile()
    Open myFile For Binary As io
      ReDim buf(1 To LOF(io))
      Get io, , buf()                             '全文一括バッファに読み込み
      vv = Split(StrConv(buf, vbUnicode), vbLf)   '←vbLF ◆ここを実際の改行コードに代える
    Close io

    For i = 0 To UBound(vv) - 1
        v = Split(vv(i), ",")            '一行分を<,>で分割  vに格納
        ReDim s(1 To 8) As String        ' 1-8列用データ 抽出
          s(1) = v(3)
          s(2) = v(6)
          s(3) = v(12)
          s(4) = v(15)
          s(5) = v(27)
          s(6) = v(70)
          s(7) = v(71)
          s(8) = v(74)
          y = y + 1                           '行カウンタ
         Cells(y, 1).Resize(, 8).Value = s    'マクロを登録したｼｰﾄへ一行分抽出
    Next
 End Sub
 . 
 追記： すべての列データが "" で括られているなら、それを取り払って かつ 数値データは
 Val()関数で 数値に変換しないといけなかったですね
 . 
（kanabun） 2014/11/29(土) 11:00

返信を記載していて衝突しました。
追加の返信ありがとうございます。
今すぐ試したいのですが、所要でＰＣ操作ができなくなります。
結果はまたアップいたします。

とりいそぎ、ありがとうございます。
（minoru） 2014/11/29(土) 11:16

抽出できました！

しかし、おっしゃるとおり全て"text"で抽出されました。
単純にs()をすべてval()で下記のように変更したところ
s(1) = Val(v(3))
全部 0 になりました。
""を取り除いたあとに数値の列に対してval()ができればＯＫと理解して

vに格納される前か格納後に　""を取り除こうと
v,vvの変数を替えたり、
vv = vv.Replace("""", "") vv = Replace(vv,"""","")と
v = v.Replace("""", "") v = Replace(v,"""","")を
色々な位置に記載して試行錯誤していますが、
◆オブジェクトがありません。
◆型が一致しません。
◆（Ｖ）の配列がありません。
とエラーになります。

そもそもの考え方が違うのでしょうか、
ご教示よろしくお願いします。
（minoru） 2014/11/29(土) 15:21

kanabun様

試行錯誤の末、なんとなく判りました、できました。
数値のヘッダ行が０表示されますが、後から記載で解決できそうです。
vv(i)の時点で""を削除で、今のところの動作しております。

csv データも奥が深いことが実感できました。

記載したコード

 For i = 0 To UBound(vv) - 1
     vv(i) = Replace(vv(i), """", "")
       v = Split(vv(i), ",")            '一行分を<,>で分割  vに格納

        ReDim s(1 To 8) As String        ' 1-8列用データ 抽出
          s(1) = Val(v(3))
          s(2) = Val(v(6))
          s(3) = v(12)
          s(4) = v(15)
          s(5) = Val(v(27))
          s(6) = v(70)
          s(7) = Val(v(71))
          s(8) = v(74)
          y = y + 1                           '行カウンタ
         Cells(y, 1).Resize(, 8).Value = s    'マクロを登録したｼｰﾄへ一行分抽出

（minoru） 2014/11/29(土) 16:03

 すみません。今まで外出していました m(_ _)m

 > 試行錯誤の末、なんとなく判りました、できました。

 ご自分で考えられて解決法を見出したときは、喜びもひとしおでしょう♪

 解決後ですが、一行づつシートに吐き出しているので、処理時間はそうとう
 長くなっていると思います。

 マクロで b.csv のvbLf を vbCrLf に一括変更しておいてから、すでに試されている
 「外部データの取り込み」テキストファイルウィザードで、列ごとのデータ型（文字列とか
 数値とか日付けとか）を指定して読み込む操作のマクロ記録をとって、それを元に
 テキストファイルウィザードでシートに展開すれば、 " " を自動で取ってくれますから
 楽をすることができるかとも 思ったりしてます。
 . 
（kanabun） 2014/11/29(土) 17:04

エラーなくマクロが走ると快感ですね。
データ取込で金曜夜から時間を費やしまして、
今は取込後の本処理をしております。
（大したことはしていませんが）

マクロで b.csv のvbLf を vbCrLf に一括変更・・・イメージは判りますが、８０％位理解できません。（恥）
宿題として後日に試行錯誤してみます。

なんとか月曜までに間に合いそうです
ありがとうございました。
（minoru） 2014/11/29(土) 19:54

 Line Inputステートメントを使っているなら、FsoからのTextStreamオブジェクトを使えば、
 これまでと同じアルゴリズムでも運用できますよ！！

 もちろん、kanabunさんのバイナリで読み込む方法は、速いですけど・・・。

 新規ブックにて　標準モジュールに

 '===========================================================================================
 Sub mk_sampledata()
    Dim g0 As Long
    Open ThisWorkbook.Path & "\sample12.txt" For Output As #1
    For g0 = 0 To 9999
       Print #1, String(200, Chr(&H41 + g0 Mod 26))
    Next
    Close #1
 End Sub
 Sub mk_sampledata2()
    Dim g0 As Long
    Open ThisWorkbook.Path & "\sample12.txt" For Output As #1
    For g0 = 0 To 9999
       Print #1, String(200, Chr(&H41 + g0 Mod 26)); vbLf;
    Next
    Close #1
 End Sub

 Sub 取込3()
    Dim myFile
    Dim myPath As String
    Dim tm As Double
   'ファイル選択
    myFile = Application.GetOpenFilename()
    If VarType(myFile) = vbBoolean Then Exit Sub
    tm = [now()]
    myPath = Left$(myFile, InStrRev(myFile, "\"))
    Dim io As Integer
    io = FreeFile()
    Open myFile For Input As io
    Dim ss As String
    Dim y As Long
    Dim v
    Do While Not EOF(io)
        Line Input #io, ss            '元データの1行目から読込
        y = y + 1                    '行カウンタ
        Cells(y, 1).Value = ss       'マクロを登録したｼｰﾄへ一行分抽出
    Loop
    Close io
    MsgBox Application.Text([now()] - tm, "hh:mm:ss.00")
 End Sub
 Sub 取込4()
    Dim myFile
    Dim myPath As String
    Dim tsm As Object
    Dim tm As Double

   'ファイル選択
    myFile = Application.GetOpenFilename()
    If VarType(myFile) = vbBoolean Then Exit Sub
    tm = [now()]
    myPath = Left$(myFile, InStrRev(myFile, "\"))
    Set tsm = CreateObject("scripting.filesystemobject").OpenTextFile(myFile, 1)
    Dim ss As String
    Dim y As Long
    Dim v
    Do While Not tsm.AtEndOfStream
       y = y + 1                    '行カウンタ
       Cells(y, 1).Value = tsm.ReadLine    'マクロを登録したｼｰﾄへ一行分抽出
    Loop
    tsm.Close
    Set tsm = Nothing
    MsgBox Application.Text([now()] - tm, "hh:mm:ss.00")
 End Sub

＊一度、このブックを　xlsmで保存してください。

 まず、mk_sampledataを実行してください、vbcrlfで行区切りのテキストデータを１００００行作成した
 テキストファイルを作成します。

 取込3及び、取込4を使って　sample12.txtを指定して、Line input　とTextstreamでの速度差を
 確認してみてください。私の環境で　0.１秒ぐらいの差でした（Line Inputの方が速い）。

 次に　mk_sampledata2を実行してください、vblfで行区切りのテキストデータを１００００行作成した
 テキストファイルを作成します。

 取込4を使ってみてください（Line Inputは、正しくvblfを行区切りと認識しない）。

 TextStreamでは、正しく読み込んでくれます。

 これを使うと大きくアルゴリズムの変更をしなくても済む　という例です。

　　
（ichinose） 2014/12/01(月) 12:47

ichinose 様

お世話になります。
コードのご教授ありがとうございます。
回答はひとつでも、多種多様なアプローチがあるのですね、
自宅のwin7は0.2秒前後の差がでました、会社のxpとwin7で明日試してみます。
開始時間とループ抜け時間の、時間差表示も大変参考になりました。
ありがとうございます。

（minoru） 2014/12/01(月) 23:43

コメント返信：

[ 一覧(最新更新順) ]

[[20141129001641]] 『ループしない』（minoru） ページの最後に飛ぶ

[[20141129001641]]　『ループしない』（minoru）　ページの最後に飛ぶ