里崎智也さんからビデオメッセージがもらえる

フォルダ内の複数あるcsvデータを
(1)ブック.csvを開く
(2)ブック内のデータをソートする
(3)データをコピーする
(4)貼り付け用ブック.xlsに貼り付け
をloopさせ実行させています
処理を少しでも早くするために
ブック.csvを開かずに(2)~(4)を実行できれば早くなるのかな?と考えています
ブック.csvを開かずに(2)~(4)を実行させることは可能でしょうか?
それとも、あまり意味がないでしょうか?

ちなみに画面更新を停止するための
Application.ScreenUpdating = False
はプログラム内に入れています

以上、よろしくお願いいたします。

このQ&Aに関連する最新のQ&A

A 回答 (5件)

1つのcsvファイル内データは50件だけということでいいんですよね。


50件くらいなら、ソートのロジックはそんなに凝る必要はないでしょう。

とりあえず、1つのcsvファイルを読み込み、ソートしてシートに書き込むまでのコードを書いておきます。
あとは、これをcsvファイルの数だけ繰り返してください。


Dim FileName As String
Dim i As Integer
Dim n As Integer
Dim Size As Integer
Dim CsvStrW As String
Dim SortStrW As String
Dim CsvStr(100) As String
Dim SortStr(100) As String
Dim CsvAry() As String
Dim RecAry() As String
Dim MaxRow As Long

FileName = "D:\AAA.csv"

Application.StatusBar = "処理中....(" & FileName & ")"
Open FileName For Input As #1
Size = 0
Do Until EOF(1)
Line Input #1, CsvStrW
CsvAry = Split(CsvStrW, ",")
SortStrW = CsvAry(0) & Chr(0) & CsvAry(1) & Chr(0) & CsvAry(2)
n = Size - 1
Do Until n < 0
If SortStr(n) <= SortStrW Then Exit Do
CsvStr(n + 1) = CsvStr(n)
SortStr(n + 1) = SortStr(n)
n = n - 1
Loop
CsvStr(n + 1) = CsvStrW
SortStr(n + 1) = SortStrW
Size = Size + 1
Loop
Close #1

ReDim RecAry(Size, 8)
For n = 0 To Size - 1
CsvAry = Split(CsvStr(n), ",")
For i = 0 To 7
RecAry(n, i) = CsvAry(i)
Next
Next

Application.ScreenUpdating = False
MaxRow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(MaxRow + 1, 1).Resize(Size, 8).Value = RecAry
Application.StatusBar = ""

この回答への補足

結果の回答が遅くなりましてすみません
自分が作成したプログラム内に入れ込むと
Open FileName For Input As #1
でデバックしてしまい
この原因がわからず悩んでいます
初歩的なことかもしれませんが・・・

教えていただいた結果が
良かったのか?悪かったのか?
また回答させてください

補足日時:2012/10/30 05:19
    • good
    • 0

まだ不明な点が。



>データ件数:2万~3万件

これはどのファイルの件数なんでしょうか?
複数あるcsvファイルの合計件数が2万~3万件ということ?


>同じ項目が1行目にある
>しかし2行目から50行目までが
>ファイルで順序が違う(必ず50行まである)

1つのcsvファイルの件数が必ず50件という意味でしょうか?
ということは、csvファイルが500個くらいあるということ?
ソートは全行に対して? それとも1行目は除く?


csvファイルごとにソートして、それを貼り付け用ブック.xlsの最後の行の下にどんどん追加していくということでいいんですよね。

この回答への補足

ファイル件数は、複数あるcsvファイルの事で
このcsvデータが2万~3万件あります

1つのcsvファイル内データが
名称(1) 名称(2) 名称(3)  判定 計測結果 上限   下限  判定
AAA  BBB  CCC   1  10  15   10  OK
DDD  SSS  ZZZ   1  13  12  10  OK
BBB  CCC  DDD   2  9   12   10  NG
50行まである
こんな感じのデータが入っていて
ソートは名称(1)(2)(3)で行います

csvファイルごとにソートして、それを貼り付け用ブック.xlsの最後の行の下にどんどん追加していくということです。

以上、処理速度が速くなりそうであれば
VBAのコードを教えていただきたく
よろしくお願いいたします。

補足日時:2012/10/18 20:37
    • good
    • 1

>テキストファイルとして読み込んで


>処理時間は早くなるでしょうか?

通常は、エクセルのシートを使わずにVBAの変数だけで処理し、シートへの書き込みも配列でまとめてドカッと書き込めば早くなります。
ただ、問題となるのはソートのアルゴリズムです。
ヘタなアルゴリズムにすればブックを開いて処理するより時間が掛かるかもしれません。
シート上でのソートは最適なアルゴリズムを使っているはずなので、VBAによるソートはそれよりも早くすることはできないと思いますが、近づけることはできます。

データ件数はどのくらいか?
1件の項目数は?
どの項目でソートする?
ソート項目の型は?
ソート項目に何か特性はあるのか?

など、これらの違いによって、どんなアルゴリズムにすれば効率よくソートできるかが変わってきます。

この回答への補足

すみません、アドバイスください
データ件数:2万~3万件
1件の項目数:8項目
どの項目でソート:3項目について優先順位をつけソート
(名称(1)(2)(3))
ソート項目の型:名称で昇順
ソート項目に何か特性:すべてのファイルに共通して
           同じ項目が1行目にある
           しかし2行目から50行目までが
           ファイルで順序が違う(必ず50行まである)
           よって、いつも同じ順序でコピー・貼り付けをしたいため
           ソートしている
これで意味がわかりますかね?

1つのファイルのイメージ
名称(1) 名称(2) 名称(3)  判定 計測結果 上限   下限  判定
AAA  BBB  CCC   1  10  15 10  OK
DDD  SSS  ZZZ   1  13  12  10  OK
BBB  CCC  DDD   2   9  12  10  NG
50行まである

以上、処理速度が速くなりそうであれば
VBAのコードを教えていただきたく
よろしくお願いいたします。

補足日時:2012/10/17 21:42
    • good
    • 1

No1さんの回答が気になるようなら、試してみればすむ話です。



もし、体感速度であまりかわらないのであれば、以下の理由が考えられます。

・膨大なデータを扱う環境ではない(1万件とか5万件とかでなく100件程度)
・ロジックに無駄が多い
・スペックが水準を満たしていない

あとはWorkbooks.OpenでなくOpenTextを使ってみるとか
    • good
    • 0

テキストファイルとして配列に読み込んでソートすれば可能です。

この回答への補足

自分が気になっている事ですが
テキストファイルとして読み込んで
処理時間は早くなるでしょうか?

補足日時:2012/10/16 19:02
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QEXCEL VBAマクロ作成で、他のEXCELからデータを取り込みたい

メインプログラム(EXCEL VBA)より、
他のフォルダーにあるEXCELの項目の内容を取り込みたいです。
たとえば他のフォルダーのEXCELのRange("A2:A3").ValueをメインプログラムのRange("C2:C3").Valueにセットしたい時です。

・コマンドボタン押したら、どこのEXCELから取り込むかのポップアップ(?)は、表示はできてます。
・作業者が選んだパスとブックもMsgBoxで表示できてるので、もらう相手の場所も取得できてます。

・となると次はOPEN,INPUTですか?
テキストデータの取り込みですと、Inputでそのバッファを定義してるのですが、なんか違うような。。。

よろしくお願いします!

Aベストアンサー

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Cells(2, 2).Value ' 相手シートの B2 の値を自分自身の A1 に書き込む

readBook.Close False ' 相手ブックを閉じる
Set readSheet = Nothing
Set readBook = Nothing

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Ce...続きを読む

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QVBA EXCEL 開かずにデータ操作

現在下記のようなコードでテストしています。

Sub Sample()

Dim TargetBook As Workbook

   Set TargetBook = Workbooks.Open("Book2.xls")
   TargetBook.Sheets("Sheet1").Cells(1, 5) = Cells(1, 1)
   TargetBook.Close

End Sub

Book2を開いてセルの読み書きはテストできました。
これをBook2をopenせず閉じた状態で操作したいと思っています。
Workbooksの表示されるメソッドを色々試してみますが出来ません。
OpenDatabaseが使用できるのかと思いますが、出来ません。
ご指導よろしくお願いします。

Aベストアンサー

Sub Sample2()
Dim myPath As String
Dim fn As String
  myPath = Application.DefaultFilePath 'パス
  fn = "Book2.xls" 'ファイル名
  'R1C1型で書く
  ret = Application.ExecuteExcel4Macro("'" & myPath & "[" & fn & "]Sheet1'!R1C1")
  ThisWorkbook.Sheets("Sheet1").Cells(1, 5) = ret
End Sub

他にも、
>OpenDatabaseが使用できる
ODBC(Open Database Connectivity)という意味でしたら、[外部データの取り込み]から操作します。ただし、その使用する列全体を使用してしまいますので、取り込みには、その以下にデータを置くことは出来ない欠点があります。

Office をインストールしていれば、Jet はインストールしていますから、当然、ADODBなどは利用できますが、意外に面倒かもしれません。フィールドがなくても取得できます。

Sub Sample2()
Dim myPath As String
Dim fn As String
  myPath = Application.DefaultFilePath 'パス
  fn = "Book2.xls" 'ファイル名
  'R1C1型で書く
  ret = Application.ExecuteExcel4Macro("'" & myPath & "[" & fn & "]Sheet1'!R1C1")
  ThisWorkbook.Sheets("Sheet1").Cells(1, 5) = ret
End Sub

他にも、
>OpenDatabaseが使用できる
ODBC(Open Database Connectivity)という意味でしたら、[外部データの取り込み]から操作します。ただし、その使用する列全体を使用してしまいますので、取り込み...続きを読む

QWorkBooksをオープンさせずにシートにコピーしたい【EXCEL VBA】

よろしくお願いします。
今あるブックにあるシートを別のブックにコピーしたいのですが、今考えているのは

ここから////////
'ブックを開く
Workbooks.Open コピー元のブックのパス
'シートをコピー
Worksheets.Item(コピーするシート名).Copy _
after:=Workbooks(コピー先のブック名).Sheets(1)

'ブックを閉じる
Application.DisplayAlerts = False
Workbooks.Item(コピー元のブック名)Close True
Application.DisplayAlerts = True
ここまで////

なのですが、コピーものとのブックが複数ある時、画面がチラチラしてしまいます。ブックをオープンさせずにシートを他ブックにコピーさせる方法ってないでしょうか。
ご存知の方がいらっしゃいましたら、ご教授お願いします。

Aベストアンサー

画面のチラツキを押さえたいだけなら、画面の更新をやめればいいだけじゃないでしょうか?

ブックを開く前に
Application.ScreenUpdating = False
ブック閉じてから
Application.ScreenUpdating = True

Q参照先のブックを開かずに内容をコピーしたい

エクセルのマクロ初心者です。
いつもここで他の方のQ&Aを参考にしたり、自分で質問したりしてお世話になっています。

今回は、参照先のブックを開かずにその内容をコピーする方法についてお聞きしたいです。
現在、下記のようなマクロを組んでいます。

Workbooks.Open FileName:="BookA.xls"
Sheets("Sheet1").Activate
Range("B4:H4").Copy
Windows("BookB.xls").Activate
Sheets("Sheet2").Select
Range("B1").Select
Sheets("Sheet2").Paste
Workbooks("BookA").Close
Windows("BookB").Activate

つまり、BookAのセルの一部分をコピーしてBookBのセルに貼り付けるという内容なんですが、コピー参照先のBookAを一度開いてコピーしてからBookBに行って貼付け、さらにBookAを閉じた後でBookBに再び戻る、という動作になっているため、画面がパラパラと切り替わる時間があって少々うっとおしいのです。
BookAをいちいち開かずに内容をコピーする方法があると思うのですが、どのような構文を使えばいいでしょうか?
ご回答よろしくお願いします。

エクセルのマクロ初心者です。
いつもここで他の方のQ&Aを参考にしたり、自分で質問したりしてお世話になっています。

今回は、参照先のブックを開かずにその内容をコピーする方法についてお聞きしたいです。
現在、下記のようなマクロを組んでいます。

Workbooks.Open FileName:="BookA.xls"
Sheets("Sheet1").Activate
Range("B4:H4").Copy
Windows("BookB.xls").Activate
Sheets("Sheet2").Select
Range("B1").Select
Sheets("Sheet2").Paste
Workbooks("BookA").C...続きを読む

Aベストアンサー

>画面がパラパラと切り替わる時間があって少々うっとおしいのです。
これだけならマクロの最初と最期で
Application.ScreenUpdating = False
処理
Application.ScreenUpdating = True
とすればいいのでは?

Q複数のCSVファイルからのデータ取得(VBA)

エクセルVBAで、エクセルの指定シートに複数のCSVファイルからデータを取得する方法を
ご教授お願います。
エクセルの指定シートの指定されたセルに、複数のCSVファイルから指定箇所のデータを
取得し転送する方法を考えていますが、どうもうまくいきません。
たとえば、
CSVファイル(1) A5(A)
          A10(B)
CSVファイル(2) A5(C)
          A10(D)     
CSVファイル(3) A5(E)
          A10(F)   
     ・
     ・
     ・
と、指定されたセルからデータを取得し、
エクセルの指定シートの表に
                   CSVファイル               
                 (1)  (2)  (3) ・ ・ ・
-------------------------------------------
A5から取得したデータ    A   C   E ・ ・ ・
A10から取得したデータ    B   D   F ・ ・ ・
-------------------------------------------
と、いうように転送して貼り付けていきたいです。

いろいろ調べてみたのですが、このような方法が見つけられませんでした。
ぜひ、皆様のお知恵をお貸しください。
宜しくお願い致します。

エクセルVBAで、エクセルの指定シートに複数のCSVファイルからデータを取得する方法を
ご教授お願います。
エクセルの指定シートの指定されたセルに、複数のCSVファイルから指定箇所のデータを
取得し転送する方法を考えていますが、どうもうまくいきません。
たとえば、
CSVファイル(1) A5(A)
          A10(B)
CSVファイル(2) A5(C)
          A10(D)     
CSVファイル(3) A5(E)
          A10(F)   
     ・
     ・
     ・
と、指定さ...続きを読む

Aベストアンサー

>読み込むCSVファイルは毎回ファイル名が変わる為、マクロでファイルを選択し、選択したファイルからそれぞれデータを取得したいのですが、変数への置き換え方が分かりません。

私は、基本的にはまったく知らない方には、ブラックボックスとして使っていただくように考えています。

ファイル名が決まっているような質問の内容でしたから、そういうコードにしたまででしたが、すでに、#2のコードを書く時に、以下のように考えていました。

試してみてください。書き換えは、必要に応じて「パスを登録」の部分だけです。
また、なくても、可能です。
ファイルの選択は、Ctrl キーを押しながらファイルを一つずつ選ぶか、シフトキーを押しながら範囲を選ぶかしてください。選択した順序どおりに処理されます。

'//
Sub TestMacro1R()
 Dim sh As Worksheet
 Dim Files As Variant
 Dim i As Long, j As Long, k As Long
 Dim oPath As String
 Dim sPath As String
 oPath = ThisWorkbook.Path
 sPath = ThisWorkbook.Path & "\MyFolder\" 'パスを登録
 Set sh = ThisWorkbook.ActiveSheet '書きだすシート
 ChDir sPath
 Files = Application.GetOpenFilename("Text(*.csv),*.csv", , "ファイル選択", , True)
 If VarType(Files) = vbBoolean Then Exit Sub
 k = 1 '書き出し列
 j = 1 '書き出し行
 For i = UBound(Files) To 1 Step -1
  If k > Columns.Count Then MsgBox "列の制限より終了します。", 48: Exit For
   Application.ScreenUpdating = False
   With Workbooks.Open(Files(i))
    sh.Cells(j, k).Value = .ActiveSheet.Range("A5").Value
    sh.Cells(j + 1, k).Value = .ActiveSheet.Range("A10").Value
    .Close False
   End With
   k = k + 1
  Application.ScreenUpdating = True
 Next
 Set sh = Nothing
 ChDir oPath
 Beep
End Sub

>読み込むCSVファイルは毎回ファイル名が変わる為、マクロでファイルを選択し、選択したファイルからそれぞれデータを取得したいのですが、変数への置き換え方が分かりません。

私は、基本的にはまったく知らない方には、ブラックボックスとして使っていただくように考えています。

ファイル名が決まっているような質問の内容でしたから、そういうコードにしたまででしたが、すでに、#2のコードを書く時に、以下のように考えていました。

試してみてください。書き換えは、必要に応じて「パスを登録」の部分だ...続きを読む

Qエクセル(VBA)にて、CSVファイルを自動的に読み込むマクロ。

aaa.csvというcsvファイルがあるとします。
そこで、
エクセルのあるシートにボタンを用意して、マクロを登録し、そのボタンを押すと、sheetという名前のシートへ一発入力(インポート)するようにしたいのです。

マクロをいじったりしましたが、だめです。
よろしければ、上記のような動作をするためのソースを簡単に提供いただけないでしょうか?
*マクロの記録は使いたくないです・・・。

すみませんが、よろしくお願いいたします。

Aベストアンサー

Workbooks.Open Filename:="aaa.csv"
LastRow = Range("A65536").End(xlUp).Row
Range("A1:I" & CStr(LastRow)).Select
Selection.Copy Destination:=Workbooks("aaa.xls").Worksheets("sheet").Range("A1")
ActiveWindow.Close

2行目は、csvファイルの最後の行番号を取得しています。
3行目ですが、列がI列まであるときの例です。

QEXCEL VBAで計算値を四捨五入、切り上げ、切捨てする方法

ネットで探してみたのですが、計算結果を四捨五入して特定のセルを
返すにはどうしたらいいのでしょうか?

Sub hokangosa()

Dim ZPS As Double
Dim ZPOS As Double
Dim DMN As Double
MsgBox (" >>> 補間誤差自動計算 <<< ")
MsgBox (" >>> 初期値入力します <<< ")
ZPS = InputBox(">>> ステップを入力してください<<<")
ZPOS = Sheet1.Cells(22, 4).Value
DMN = ZPOS / ZPS
Sheet1.Cells(23, 6).Value = DMN
End Sub

ここでDMNの値を四捨五入したいです。

またこれとは別に切上げ、切捨ても教えていただけるとありがたいです。

Aベストアンサー

DMN = Application.WorksheetFunction.Round(ZPOS / ZPS, 0)
で、四捨五入
DMN = Application.RoundDown(ZPOS / ZPS, 0)
で切り捨て
DMN = Application.RoundUp(ZPOS / ZPS, 0)
で切り上げです。

引数で、対象桁を変更できます。

QエクセルVBA 大容量CSVファイルの読み込みが遅い

800万行、1.4GBのCSVファイルをLineにより100万行ずつシートに読み込み、処理してます。
100万行読み込み
コンマを区切り文字にして展開
データ処理
次の100万行読み込み
の手順です。

出だしは快調で1シート20秒程度で読み込みます。ところが、シートを重ねるごとにだんだん遅くなり、1シート5分、最後の方はメモリーオーバーでエラーとなり、最後まで行き着いてません。ウインドウ下枠に表示される「フィル」で時間がかかります。その後で表示される「区切り位置」以降、データ処理は普通です。おそらくLineによる読み込みで時間がかかっていると思います。なぜでしょうか?どうすればいいでしょうか?

エラー位置はDoの3行下です。
Sub Macro1()

Dim vFile As Variant
Dim WSdata As Worksheet
Dim ffn As Long
Dim vA() As Variant
Dim j As Long, k As Long

Const Half As Long = 500000 ' 1回の書き出し行数
Const CROWSZ As Long = 1000000 '1シートへの書き出し数
vFile = ThisWorkbook.Path & "\CSVconverted.CSV"

ReDim vA(1 To UnitRead, 1 To 1)

'100万行を入力するワークシート
Set WSdata = ThisWorkbook.Worksheets("CSV")

'CSVファイルを開く
ffn = FreeFile()
Open vFile For Input As #ffn

j = 1
k = 1
Do
Line Input #ffn, vA(j, 1)   '1行ずつ読み込み
If j >= Half Or EOF(ffn) Then
WSdata.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(UBound(vA), 1).Value = vA 'ここで止まる。vAにマウスを当てると「メモリーオーバー」と表示
ReDim vA(1 To UnitRead, 1 To 1)
j = 0

If k >= CROWSZ Or EOF(ffn) Then
      'コンマを区切り文字にして展開
With WSdata.Range(WSdata.Cells(2, "A"), WSdata.Cells(Rows.Count, "A").End(xlUp))
Application.DisplayAlerts = False
.TextToColumns .Cells(1), xlDelimited, Comma:=True
Application.DisplayAlerts = True
End With
k = 0


'データ処理がここに記載


WSdata.Cells.ClearContents
End If
End If
j = j + 1
k = k + 1
Loop While Not EOF(ffn)
Close #ffn 'CSV閉じる

End Sub

800万行、1.4GBのCSVファイルをLineにより100万行ずつシートに読み込み、処理してます。
100万行読み込み
コンマを区切り文字にして展開
データ処理
次の100万行読み込み
の手順です。

出だしは快調で1シート20秒程度で読み込みます。ところが、シートを重ねるごとにだんだん遅くなり、1シート5分、最後の方はメモリーオーバーでエラーとなり、最後まで行き着いてません。ウインドウ下枠に表示される「フィル」で時間がかかります。その後で表示される「区切り位置」以降、データ処理は普通です。おそら...続きを読む

Aベストアンサー

No.4ママチャリです。
まず①の件ですが、確かに Office 2013 and later となっていますね。でも、私の環境もExcel2010ですが、ヘルプにも掲載されているし、実際、StartRowで指定した行から読み込めています。各種ホームページを見ても2013より前のバージョンでも話題になっているので、問題ないと思います。

②の方ですが、OverTheGalaxyさんが書いたコード(Workbooks.OpenText Filename:=vFile, DataType:=xlDelimited, startrow:=ReadRow, comma:=True)を実際に動かしたところ、正常に動きました。確かにstartrowは大文字になりませんでしたが・・・。

試しに、[ファイル]ー[開く]の手順をマクロに記録し、それをベースに実験してみてはいかがでしょうか。各種HPを見ていて、「省略可能なパラメータと書いてあるくせに、省略したら問題が発生した」みたいな記事がありましたので・・・。

マクロを記録する際、列数が多いと FieldInfo パラメータがあふれることがあります。ただ、形式を指定する必要がなければ、不要なものなので捨てちゃってOKです。

では、ご検討をお祈りします。
それにしても、同じ環境(2010ではやっていないのでしたっけ?)で動作が異なるとは、Micr●s●ftらしいですね。

No.4ママチャリです。
まず①の件ですが、確かに Office 2013 and later となっていますね。でも、私の環境もExcel2010ですが、ヘルプにも掲載されているし、実際、StartRowで指定した行から読み込めています。各種ホームページを見ても2013より前のバージョンでも話題になっているので、問題ないと思います。

②の方ですが、OverTheGalaxyさんが書いたコード(Workbooks.OpenText Filename:=vFile, DataType:=xlDelimited, startrow:=ReadRow, comma:=True)を実際に動かしたところ、正常に動きました。確かにstar...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング