Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9009 / 13644 ツリー ←次へ | 前へ→

【29823】CSVからデータの取込 ほびっと 05/10/14(金) 12:01 質問[未読]
【29828】Re:CSVからデータの取込 awu 05/10/14(金) 14:34 回答[未読]
【29830】Re:CSVからデータの取込 小僧 05/10/14(金) 14:58 発言[未読]
【29838】Re:CSVからデータの取込 ほびっと 05/10/14(金) 15:59 質問[未読]
【29845】Re:CSVからデータの取込 小僧 05/10/14(金) 16:53 発言[未読]
【29850】Re:CSVからデータの取込 ほびっと 05/10/14(金) 17:14 発言[未読]
【29852】Re:CSVからデータの取込 小僧 05/10/14(金) 18:34 発言[未読]
【29853】Re:CSVからデータの取込 ほびっと 05/10/14(金) 19:25 お礼[未読]
【29848】Re:CSVからデータの取込 小僧 05/10/14(金) 17:09 発言[未読]
【29834】Re:CSVからデータの取込 awu 05/10/14(金) 15:15 発言[未読]
【29839】Re:CSVからデータの取込 ほびっと 05/10/14(金) 16:02 発言[未読]

【29823】CSVからデータの取込
質問  ほびっと  - 05/10/14(金) 12:01 -

引用なし
パスワード
   データ件数が10万件を超えるCSVファイルがあります。
11,ab,aba,bba・・・
11,ab,abb,bab
11,ab,abc,bbc
12,ba,baa,bbb
12,ba,baa,bbc
13,ca,cab,ccc
・・・
CSVファイルは上記のように、1列目が同じデータがいくつか続きます。
ここから1列目のデータが変わる最初の行のみデータを取り出し、エクセルファイルに書き込みます。
11,ab,aba,bba・・・
12,ba,baa,bbb
13,ca,cab,ccc
・・・

現在はInputを使用して実行していますが、件数が多いため処理に時間がかかります。
コードの一部です。
  intFF = FreeFile
  iWt = 1
  Open ThisWorkbook.Path & "\tmp.csv" For Input As #intFF
  Do Until EOF(intFF)
    Input #intFF, sCon(1), sCon(2), sCon(3), sCon(4), sCon(5), sCon(6), sCon(7), sCon(8), _
          sCon(9), sCon(10), sCon(11), sCon(12), sCon(13), sCon(14), sCon(15)
    If Not sCBF = sCon(1) Then '1列目)が変わったら書き込む
      For iCt = 1 To 8 '8まで取り込む
        Cells(iWt, iCt).NumberFormatLocal = "@" '取込先のセル書式を文字列にする
        Cells(iWt, iCt) = sCon(iCt)
      Next iCt
      sCBF = sCon(1) '比較用
    End If
  Loop
  Close #intFF

処理をデータベースクエリで行ったら、早くなるような気がするのですが、方法が分かりません。
ご教授願えれば幸いです。
(Win2000/Excel2002)

【29828】Re:CSVからデータの取込
回答  awu  - 05/10/14(金) 14:34 -

引用なし
パスワード
   ちょっと、簡潔なコードにしてみましたので、宜しかったら時間を
比較してみてください。

For〜Nextを無くしたのですが、処理時間は、どんな感じでしょうか。

Sub CsvRead()
Dim Num As Integer
Dim Rw As Long
Dim LineDat As String
Dim LeftStr As String
Const Cols = 8 ' <--- 取得列数
Dim D
Num = FreeFile
Application.ScreenUpdating = False
Cells.Delete
Range("A:A").Resize(, Cols).NumberFormatLocal = "@"
Open ThisWorkbook.Path & "\data.csv" For Input As #Num
Do Until EOF(Num)
  Line Input #Num, LineDat
  D = Split(LineDat, ",")
  ReDim Preserve D(Cols)
  If Not LeftStr = D(0) Then
    Range("A1").Resize(, UBound(D)).Offset(Rw).Value = D
    LeftStr = D(0)
    Rw = Rw + 1
    If Rw = 65537 Then
      MsgBox "行数が多過ぎて取込めない部分がある可能性があります。"
      Exit Do
    End If
  End If
Loop
Close #Num
Application.ScreenUpdating = True
End Sub

【29830】Re:CSVからデータの取込
発言  小僧  - 05/10/14(金) 14:58 -

引用なし
パスワード
   ▼ほびっとさん、awu さん:
こんにちは。

Sub 配列でやってみよう()
Dim intFF As Long
Dim sCon(1 To 15) As Variant
Dim sCbf As Long
Dim Data() As Variant
Dim i As Long
Dim j As Long

  intFF = FreeFile
  Open ThisWorkbook.Path & "\tmp.csv" For Input As #intFF
  
  i = 0
  Do Until EOF(intFF)
  Input #intFF, sCon(1), sCon(2), sCon(3), sCon(4), sCon(5), sCon(6), sCon(7), sCon(8), _
          sCon(9), sCon(10), sCon(11), sCon(12), sCon(13), sCon(14), sCon(15)
    If Not sCbf = sCon(1) Then
      '配列にいれてみよう
      ReDim Preserve Data(8, i)
      For j = 0 To 7
        Data(j, i) = sCon(j + 1)
      Next
      i = i + 1
      sCbf = sCon(1)
    End If
  Loop
  Close #intFF
  ActiveSheet.Cells(1, 1).Resize(UBound(Data, 2) + 1, 8).Value = Application.Transpose(Data)
  ActiveSheet.Cells(1, 1).Resize(UBound(Data, 2) + 1, 8).NumberFormatLocal = "@"
End Sub

やっている事が余り変わりないので、速度は awu さんと同じくらいでしょうか。


>処理をデータベースクエリで行ったら、
>早くなるような気がするのですが、方法が分かりません。

この速度でもまだ遅いと思われるのでしたら、ADO なり DAO で処理も
考えてみようと思いますがいかがでしょうか。

※ もし、使われている元の csv が Ken_ALL でしたら、
  テーブルを扱う上では「一番上」という概念がないので

>データが変わる最初の行

  という判断は出来ない事になりますね。
  (フィールド 3 の値が最小のものをグループ化は可能ですが。)

【29834】Re:CSVからデータの取込
発言  awu  - 05/10/14(金) 15:15 -

引用なし
パスワード
   あっ 間違えました。 

1行目からの Offset値ですから

If Rw = 65537 Then

は、

If Rw = 65536 Then

に訂正します。

【29838】Re:CSVからデータの取込
質問  ほびっと  - 05/10/14(金) 15:59 -

引用なし
パスワード
   awuさん、小僧さん、こんにちは。
さっそくに回答いただきありがとうございます。

この処理部分で30秒以上かかっていたのですが、お二人のコードでやってみたところ、どちらも数秒で処理できるようになり、大きく改善されました。

まずはお礼申し上げます。ありがとうございました。

さらに質問させて下さい。

小僧さんの方法ですと、数の頭の0が落ちてしまうのですが?
 「01111」→「1111」
>
>>処理をデータベースクエリで行ったら、
>>早くなるような気がするのですが、方法が分かりません。
>
>この速度でもまだ遅いと思われるのでしたら、ADO なり DAO で処理も
>考えてみようと思いますがいかがでしょうか。

ADOで、できるのであれば考えていただけないでしょうか。
ぜひともよろしくお願いします。

>※ もし、使われている元の csv が Ken_ALL でしたら、
>  テーブルを扱う上では「一番上」という概念がないので
>
>>データが変わる最初の行
>
>  という判断は出来ない事になりますね。
>  (フィールド 3 の値が最小のものをグループ化は可能ですが。)

ご推察の通り、Ken_ALL.csvです。

フィールド1でのグループ化はできないということでしょうか。

例えば、ADOでKen_ALL.csvに接続できたとして
.MoveFirst
.Find 条件, , adSearchForward
で見ていった場合、Ken_ALL.csvの1行目から順に見ていってくれないのでしょうか?

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

【29839】Re:CSVからデータの取込
発言  ほびっと  - 05/10/14(金) 16:02 -

引用なし
パスワード
   awuさん、ありがとうございます。
修正しました。
感謝です!

【29845】Re:CSVからデータの取込
発言  小僧  - 05/10/14(金) 16:53 -

引用なし
パスワード
   ▼ほびっと さん:
こんにちは。

>小僧さんの方法ですと、数の頭の0が落ちてしまうのですが?
> 「01111」→「1111」

セルを文字列型にする前にデータを貼り付けてしまいました。

ActiveSheet.Cells(1, 1).Resize(UBound(Data, 2) + 1, 8).Value = Application.Transpose(Data)
ActiveSheet.Cells(1, 1).Resize(UBound(Data, 2) + 1, 8).NumberFormatLocal = "@"

上記2行を入れ替えてみて下さい。

>ADOで、できるのであれば考えていただけないでしょうか。
>ぜひともよろしくお願いします。
>例えば、ADOでKen_ALL.csvに接続できたとして
> .MoveFirst
> .Find 条件, , adSearchForward
>で見ていった場合、Ken_ALL.csvの1行目から順に見ていってくれないのでしょうか?

まず、Ken_ALLには見出し行がないのを忘れていました。
CSVファイルを ADO で処理するためには1行目にフィールド名を
入れる必要がでてきてしまいますね。

次に…
Ken_ALL をそのまま開いてしまうと、約12万レコードの処理となります。
さすがに12万レコードのテーブルに対して「MoveNext」を繰り返し使う処理をすると
時間がかかるため、SQL の Where句などを駆使して
Open するレコードに制限を掛けるべきだと思います。

そこで

>>>テーブルを扱う上では「一番上」という概念がないので

という表現になってしまったのですが…。
Ken_ALL に ID のような連番がついていて、フィールド1 でグループ化してIDが最小のもの
というような条件でしたら、SQL で一回で処理できると思います。

【29848】Re:CSVからデータの取込
発言  小僧  - 05/10/14(金) 17:09 -

引用なし
パスワード
   ▼ほびっと さん:
>ごめんなさい、ADO の使用例を載せ忘れていました。

Sub ADOで()
Dim adoCON As Object
Dim adoRS As Object

  Set adoCON = CreateObject("ADODB.Connection")
  Set adoRS = CreateObject("ADODB.Recordset")
  adoCON.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
         "DBQ=" & ThisWorkbook.Path & ";" & _
         "ReadOnly=0"
  
  adoRS.Open "select * from tmp.csv", adoCON, 3

  'ここに処理
    Debug.Print adoRS.RecordCount
  
  adoRS.Close
  adoCON.Close
  Set adoRS = Nothing
  Set adoCON = Nothing
End Sub

こんな感じでレコードカウントがイミディエトウィンドウに
表示されたかと思います。

【29850】Re:CSVからデータの取込
発言  ほびっと  - 05/10/14(金) 17:14 -

引用なし
パスワード
   小僧さん、」早速に回答ありがとうございます。
>▼ほびっと さん:
>こんにちは。
>
>>小僧さんの方法ですと、数の頭の0が落ちてしまうのですが?
>> 「01111」→「1111」
>
>セルを文字列型にする前にデータを貼り付けてしまいました。
>
>ActiveSheet.Cells(1, 1).Resize(UBound(Data, 2) + 1, 8).Value = Application.Transpose(Data)
>ActiveSheet.Cells(1, 1).Resize(UBound(Data, 2) + 1, 8).NumberFormatLocal = "@"
>
>上記2行を入れ替えてみて下さい。

うまくいきました。ありがとうございます。

>>ADOで、できるのであれば考えていただけないでしょうか。
>>ぜひともよろしくお願いします。
>>例えば、ADOでKen_ALL.csvに接続できたとして
>> .MoveFirst
>> .Find 条件, , adSearchForward
>>で見ていった場合、Ken_ALL.csvの1行目から順に見ていってくれないのでしょうか?
>
>まず、Ken_ALLには見出し行がないのを忘れていました。
>CSVファイルを ADO で処理するためには1行目にフィールド名を
>入れる必要がでてきてしまいますね。
>
>次に…
>Ken_ALL をそのまま開いてしまうと、約12万レコードの処理となります。
>さすがに12万レコードのテーブルに対して「MoveNext」を繰り返し使う処理をすると
>時間がかかるため、SQL の Where句などを駆使して
>Open するレコードに制限を掛けるべきだと思います。
>
>そこで
>
>>>>テーブルを扱う上では「一番上」という概念がないので
>
>という表現になってしまったのですが…。
>Ken_ALL に ID のような連番がついていて、フィールド1 でグループ化してIDが最小のもの
>というような条件でしたら、SQL で一回で処理できると思います。

大変わかりやすい説明ありがとうございます。
納得いたしました。

VBAでKen_ALLの見出し行(1行目にフィールド名)を挿入することはできるのですか?

【29852】Re:CSVからデータの取込
発言  小僧  - 05/10/14(金) 18:34 -

引用なし
パスワード
   ▼ほびっと さん:
こんにちは。

>VBAでKen_ALLの見出し行(1行目にフィールド名)を挿入することはできるのですか?

VBA でテキスト操作はできるのですが、

1) Temp と言う名前で CSV ファイルを Open
2) Ken_ALL を Open
3) Temp の1行目に見出し行を追加
4) Temp の2行目から Ken_ALL を追加
5) Temp を Ken_ALL と言う名前で上書きコピー
6) Ken_ALL を削除

というような面倒な処理になります。

そこで「schema.ini」を作ってみましょう。
Ken_ALL と同じフォルダに

[Ken_ALL.csv]
ColNameHeader=False
CharacterSet=oem
Format=CSVDelimited
Col1=F1 Integer
Col2=F2 Char Width 255
Col3=F3 Char Width 255
Col4=F4 Char Width 255
Col5=F5 Char Width 255
Col6=F6 Char Width 255
Col7=F7 Char Width 255
Col8=F8 Char Width 255
Col9=F9 Char Width 255
Col10=F10 Integer
Col11=F11 Integer
Col12=F12 Integer
Col13=F13 Integer
Col14=F14 Integer
Col15=F15 Integer

と記述して「schema.ini」という名前で保存。

これで取り込む際にフィールド名が付加されます。


Sub 東京都だけ抽出()
Dim adoCON As Object
Dim adoRS As Object
Dim strSQL As String
Dim FName As String

  Set adoCON = CreateObject("ADODB.Connection")
  Set adoRS = CreateObject("ADODB.Recordset")
  adoCON.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
         "DBQ=" & ThisWorkbook.Path & ";" & _
         "ReadOnly=0"
  
  
  strSQL = "SELECT F1,F2,F3,F4,F5,F6,F7,F8 " _
      & "FROM Ken_ALL.csv Where F7 = '東京都'"
  
  adoRS.Open strSQL, adoCON, 3

  adoRS.MoveLast
  ActiveSheet.Cells(adoRS.RecordCount, 8).NumberFormatLocal = "@"
  adoRS.MoveFirst
  ActiveSheet.Cells(1, 1).CopyFromRecordset adoRS
  
  adoRS.Close
  adoCON.Close
  Set adoRS = Nothing
  Set adoCON = Nothing
End Sub

東京都だけ抽出するサンプルコートです。

Ken_ALL に ユニークな値がないので、

>1列目のデータが変わる最初の行のみ

という処理まで思いつきませんでした。すみません。

【29853】Re:CSVからデータの取込
お礼  ほびっと  - 05/10/14(金) 19:25 -

引用なし
パスワード
   小僧さん、ありがとうございます。
schema.iniですね、勉強になります。
ADOでも色々と試してみようと思っています。

やってみて何かありましたら、質問させていただきます。

また他に良い方法思いついたら、ぜひとも書き込みお願いします。
(気長に構えてます。)

よろしくお願いします。

9009 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free