[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『CSVを文字列で読み込む（高速）』（おぐり）
以下のコード読み込むと15秒程で読み込めるのですが
列の書式が標準なので一部でマイナス(-)で始まる場合
数値で登録されてしまいます。
そのため、B列＆A列とするとエラーがでます。
'CSVの読み込み
Workbooks.Open Filename:=varFileName
ActiveSheet.Cells.Copy ThisWorkbook.ActiveSheet.Cells
ActiveWorkbook.Close SaveChanges:=False
ネットを参考にして文字列が欲しいので
以下でCSVを読み込むと5分ほど必要で待ち時間が長すぎます。
Sub CSV入力1()
Dim varFileName As Variant
Dim intFree As Integer
Dim strRec As String
Dim strSplit() As String
Dim i As Long, j As Long
varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
Title:="CSVファイルの選択")
If varFileName = False Then
Exit Sub
End If
intFree = FreeFile '空番号を取得
Open varFileName For Input As #intFree 'CSVファィルをオープン
i = 0
Do Until EOF(intFree)
Line Input #intFree, strRec '1行読み込み
i = i + 1
strSplit = Split(strRec, ",") 'カンマ区切りで配列へ
For j = 0 To UBound(strSplit)
Cells(i, j + 1) = strSplit(j)
Next
Loop
Close #intFree
End Sub
そこで質問ですが、CSVをシートに読み込む時に全ての列（総数は4つ / A,B,C,D）を文字列で読み込んで
必要なのは、A列とB列でそれ以外は必要ないので
最終的には文字結合(B列＆A列相当)をA列に書き出したいのですが
なるべく高速なVBAを知りたいです。
＜ 使用 Excel：Excel2021、使用 OS：Windows11 ＞
＞列の書式が標準なので
よく分からないですが、そう言う原因なら A,B列を事前に文字列書式にしておけばいい、と言う話になりませんか？
（半平太） 2024/01/27(土) 12:59:20
少し早くなるコードに書き替えました。
一度書き出した値（A,B列）を配列に入れて
B＆AでA列に再度書き出すと言う
苦肉の策ですが他にもう少し早くなる対策ありますか ？
Sub MojiJoin()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Worksheets("読み込み")
'csv書き出しシートを初期化
sh1.Cells.Clear
Dim CSVFileName As Variant
Dim startTime As Double
Dim endTime As Double
Dim processTime As Double
'読み込むCSVを指定
CSVFileName = "C:\Users\momo\Desktop\Terget.csv"
MsgBox "Listファイル(.csv)を読み込みます。"
'開始時間取得
startTime = Timer
'画面更新停止
Application.ScreenUpdating = False
'---------------------------------------
'CSVの読み込み(全て文字列で）
sh1.Range("A:B").NumberFormatLocal = "@"
Dim buf As String, A As Variant, i As Long
Open CSVFileName For Input As #1
Do Until EOF(1)
i = i + 1
Line Input #1, buf
A = Split(buf, ",")
sh1.Cells(i, 1).Resize(, 2) = Split(buf, ",")
Loop
Close #1
'-----------------------------------------------------
Dim lc As Long
Dim RA() As String, RB() As String, RT() As String
lc = sh1.Cells(Rows.Count, 1).End(xlUp).Row
ReDim RA(1 To lc)
ReDim RB(1 To lc)
ReDim RT(1 To lc)
For i = 1 To lc
RA(i) = sh1.Cells(i, "A")
RB(i) = sh1.Cells(i, "B")
RT(i) = RB(i) & " −" & RA(i)
sh1.Cells(i, "A") = RT(i)
Next
sh1.Range("B:B").Delete
Application.ScreenUpdating = True
endTime = Timer
processTime = endTime - startTime
processTime = Round(processTime, 1)
MsgBox "処理が終了しました。 [" & processTime & "] 秒"
Set sh1 = Nothing
End Sub
（おぐり） 2024/01/27(土) 13:51:12
コードは、簡素で短くなりましたが
A列に書き出される結合文字列の前後に”(クォーテーションマーク)が必ず入ります。
ローカルウインドウを見ると
arrLine(0)の値が "" tyui"" のように”(クォーテーションマーク)が前後に２つずつあります。
結合時の”(クォーテーションマーク)は必要ないので削除したいのですがどうしたら良いでしょうか ？
Sub MojiJoin()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Worksheets("読み込み")
'csv書き出しシートを初期化
sh1.Cells.Clear
Dim CSVFileName As Variant
Dim startTime As Double
Dim endTime As Double
Dim processTime As Double
'読み込むCSVを指定
CSVFileName = "C:\Users\momo\Desktop\Terget.csv"
MsgBox "Listファイル(.csv)を読み込みます。"
'開始時間取得
startTime = Timer
'画面更新停止
Application.ScreenUpdating = False
'---------------------------------------
'CSVの読み込み(全て文字列で）
'''' sh1.Range("A:B").NumberFormatLocal = "@"
Dim strLine As String
Dim arrLine As Variant
Dim i As Long
' CSVファイルをオープン
Open CSVFileName For Input As #1
i = 1
Do Until EOF(1)
Line Input #1, strLine
arrLine = Split(strLine, ",") ' カンマで分割して配列に格納
' 1番目と2番目のデータを結合してA列に書き出す
sh1.Cells(i, 1).Value = arrLine(1) & " - " & arrLine(0)
i = i + 1
Loop
Close #1
Application.ScreenUpdating = True
endTime = Timer
processTime = endTime - startTime
processTime = Round(processTime, 1)
MsgBox "処理が終了しました。 [" & processTime & "] 秒"
Set sh1 = Nothing
End Sub
（おぐり） 2024/01/27(土) 15:59:18
あれ？ また変えたんですか？
以下は、以前のコードをベースに考えたものです。 ※こちらではどんなデータなのか分からないので、ろくに検証しておりませんけど。
Sub MojiJoin()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Worksheets("読み込み")
'csv書き出しシートを初期化
sh1.Cells.Clear
Dim CSVFileName As Variant
Dim startTime As Double
Dim endTime As Double
Dim processTime As Double
'読み込むCSVを指定
CSVFileName = "C:\Users\momo\Desktop\Terget.csv"
MsgBox "Listファイル(.csv)を読み込みます。"
'開始時間取得
startTime = Timer
'CSVの読み込み(全て文字列で）
sh1.Range("A:B").NumberFormatLocal = "@"
Dim dicT As Object, temp
Set dicT = CreateObject("Scripting.Dictionary")
Dim buf As String, A As Variant, i As Long
Open CSVFileName For Input As #1
Do Until EOF(1)
i = i + 1
Line Input #1, buf
A = Split(buf, ",")
temp = A(1) & " −" & A(0)
dicT(i) = temp
Loop
Close #1
'-----------------------------------------------------
temp = dicT.items
sh1.Range("A1").Resize(dicT.Count) = Application.Transpose(temp)
dicT.RemoveAll
endTime = Timer
processTime = endTime - startTime
processTime = Round(processTime, 1)
MsgBox "処理が終了しました。 [" & processTime & "] 秒"
Set sh1 = Nothing
End Sub
（半平太） 2024/01/27(土) 16:03:10
お騒がせしました。
13：51：12のコードは、あまりにも無駄な事を行っていると
自分りに思えたので見直しました。
回答された以下の記載内容が理解できなくて
temp = dicT.items
sh1.Range("A1").Resize(dicT.Count) = Application.Transpose(temp)
dicT.RemoveAll
これは、どのような事でしょうか ？
’＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
CSVをテキストエディターで表示すると元からダブルクォーテーションで囲まれていました。
「ダブルクォーテーションで囲まれているCSVファイル」で
ネット情報を検索したらそのものずばりがヒットして
エクセルVBAでエクセルVBAでダブルクォーテーションで囲まれているCSVファイルを取り込むを取り込む https://tonari-it.com/vba-csv-double-quotation/#toc3
記事にある
Replace(strLine, """", "")
を嚙ますことでダブルクォーテーションが外れて思ったような表示になりました。
arrLine = Split(Replace(strLine, """", ""), ",")
（おぐり） 2024/01/27(土) 17:41:20
＞ temp = dicT.items
＞ sh1.Range("A1").Resize(dicT.Count) = Application.Transpose(temp)
＞ dicT.RemoveAll
＞これは、どのような事でしょうか ？
dictionaryに書きこんだ「2番目＆1番目」の結合文字列集合を配列に取り出し 同配列は横方向になっているので、縦方向に変換後、エクセルに書き出し dictionaryのデータを削除
（半平太） 2024/01/27(土) 17:53:32
上手く処理できました。
それも大幅な時間短縮ができました。
おぐりのコード ： 52秒
半平太さんのコード 9秒
これほど大差がつくとは思っていなかったので嬉しい結果です。
（おぐり） 2024/01/28(日) 07:38:32
検証が十分できていませんでした。
チェックすると
EmEditorで499201行あるCSVを半平太さんのコードで処理すると
40450までは上手く処理出来ているようですが
それ以後が＃N/Aエラーが最後まで続いていました。
おぐりのコードでは、499202行まで＃N/Aエラーなく正常に処理されています。
このため、処理時間に差が出たようです。
CSVは、Shit_Jisで保存されていますが、これは関係ありますか？
（おぐり） 2024/01/28(日) 08:45:05
Application.Transpose は配列のサイズに制限があるのでそれが原因かも。 ただ、下記のよると上限は65,537行なので別の原因かも。
https://mwkexcelfriend.com/excel-vba-transpose-genkai/
Transposeの制限が原因なら、 Dictionary は使わずに動的配列に結果を格納するようにすることになるでしょう。
（hatena） 2024/01/28(日) 11:47:34
■１
＞13：51：12のコードは、あまりにも無駄な事を行っていると
＞自分りに思えたので見直しました。
気づかれたのかわかりませんが、最初のコードの時間がかかっているのは、必要のないセルを含めて１セルずつ書き出し処理をしていたためでしょう。
■２
＞一度書き出した値（A,B列）を配列に入れて
＞B＆AでA列に再度書き出すと言う
＞苦肉の策ですが
「■１」に関連しますが、（１行ずつ）書き出す前に結合処理をすると考えてみてはどうでしょうか？
すなわちこんな感じです。
Sub 実験用1()
Dim varFileName As Variant
Dim intFree As Integer
Dim strRec As String
Dim strSplit() As String
Dim i As Long
varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", Title:="CSVファイルの選択")
If varFileName = False Then
Exit Sub
End If
intFree = FreeFile '空番号を取得
Open varFileName For Input As #intFree 'CSVファィルをオープン
Do Until EOF(1)
Line Input #intFree, strRec '1行読み込み
strSplit = Split(strRec, ",") 'カンマ区切りで配列へ
'▼結合してから（１行ずつ）書き出し
ActiveSheet.Cells(i + 1, "A").Value = strSplit(1) & strSplit(0)
i = i + 1
Loop
Close #intFree
End Sub
■３
＞記事にある
＞Replace(strLine, """", "")
＞を嚙ますことでダブルクォーテーションが外れて思ったような表示になりました。
そちらは、【Replace関数】ですが、【Replaceメソッド】であれば、出力後の結果（セル範囲）を対象に一括して処理ができます。
元データの量や内容が分からないので、どちらが早いかわかりませんが研究してみてはどうでしょうか？
■４
データ量によりますが、「■２」のように1行ずつ書き込むより、"一括"して書き込む方が早いかもしれません。
半平太さんの案と基本的には変わっておりませんが、DictionaryオブジェクトやTranspose関数を使わない方法を考えてみたので提示しておきます。
Sub 実験用2()
Dim 二次元配列(1048575, 0) As String
Dim varFileName As Variant
Dim intFree As Integer
Dim strRec As String
Dim strSplit() As String
Dim i As Long
varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", Title:="CSVファイルの選択")
If varFileName = False Then
Exit Sub
End If
intFree = FreeFile '空番号を取得
Open varFileName For Input As #intFree 'CSVファィルをオープン
Do Until EOF(1)
Line Input #intFree, strRec '1行読み込み
strSplit = Split(strRec, ",") 'カンマ区切りで配列へ
二次元配列(i, 0) = strSplit(1) & strSplit(0)
i = i + 1
Loop
Close #intFree
With ActiveSheet.Range("A1").Resize(1048576)
.Value = 二次元配列
.Replace What:="""", Replacement:=""
End With
End Sub
（もこな２） 2024/01/28(日) 12:10:35
With ActiveSheet.Range("A1").Resize(1048576)
.Value = 二次元配列
.Replace What:="""", Replacement:=""
End With
↓に変更
With ActiveSheet.Range("A1").Resize(1048576)
.NumberFormatLocal = "@"
.Value = 二次元配列
.Replace What:="""", Replacement:=""
End With
（もこな２） 2024/01/28(日) 12:18:36
前回の回答で動的配列を利用するとしましたが、静的配列でいいですね。 動的配列は1時限目(行数)は拡張できないので。 静的配列でシートの最大行数分のサイズを確保しておきます。
と投稿しようと思ったら、すでにもこな２さんがそのままの回答してました。
最後の代入部分は下記でいいかな。
With ActiveSheet.Range("A1").Resize(i - 1)
.NumberFormatLocal = "@"
.Value = 二次元配列
.Replace What:="""", Replacement:=""
End With
i - 1 がCSV行数になるのでそのサイズのセル範囲に代入でいいかと。 （hatena） 2024/01/28(日) 12:25:25
EmEditorでCSVのダブルクォーテーションを削除したCSVファイルに再構成して保存した
CSVファイルをターゲットにするようにしたので
Replace(strLine, """", "")を噛ますのを止めました。
（これで処理時間が大幅に変わる事は無いでしょうが)
検証結果、実験用1，実験用2 共に最後の行まで出力されました。
処理時間
おぐり 49秒
実験用1 52秒
実験用2 9.5秒 Resize(1048576)
実験用2 9.0秒 Resize(i-1)
実験用1は、１分近くWaitingすると少し不安な待ち時間ですが
実験用2は、9-10秒ほどで終了するので十分満足な結果だと思います。
CSV行数を499201/1048576と半分以下にセットすると0.5秒程短縮されるようです。
（おぐり） 2024/01/28(日) 15:05:15
十分実用的な速度は出ていると思いますが、もう少し高速化できそうなコード例
Binaryモードで一気に読み込んで、Splitで分割して処理してみました。
Sub BinaryGetCSV()
Dim strFileName As String
Dim intFree As Integer
Dim bytBuf() As Byte
Dim strRows() As String
Dim strCols() As String
Dim ary() As String
Dim i As Long
strFileName = "C:\Users\momo\Desktop\Terget.csv"
intFree = FreeFile
Open strFileName For Binary As #intFree
ReDim bytBuf(LOF(intFree))
Get #intFree, , bytBuf
Close #intFree
strRows = Split(StrConv(bytBuf(), vbUnicode), vbCrLf)
ReDim ary(UBound(strRows) - 1, 0)
For i = 0 To UBound(ary)
strCols = Split(strRows(i), ",")
ary(i, 0) = strCols(1) & strCols(0)
Next
With ActiveSheet.Range("A1").Resize(i)
.Value = ary
End With
End Sub
当方のサンプルでは若干高速化されてる感じです。
（hatena） 2024/01/28(日) 17:41:41
したがって、配列とかよくわからないし、多少時間がかかってもよいので配列を使わずに（意識せずに）何とかしたいということであれば、↓のように極力【一気に処理する】ことを考えるだけでも、それなりの改善になったと思います。
Sub 実験用3()
Dim varFileName As Variant
varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", Title:="CSVファイルの選択")
If varFileName = False Then Exit Sub
Application.ScreenUpdating = False
With ActiveSheet
With .QueryTables.Add(Connection:="TEXT;" & varFileName, Destination:=.Range("A1"))
.TextFilePlatform = 932
.TextFileColumnDataTypes = Array(2, 2, 9, 9)
.TextFileCommaDelimiter = True
.Refresh
.Delete
End With
With .Range("C1", .Cells(.Rows.Count, "A").End(xlUp).Offset(, 2))
.Formula = "=B1&A1"
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
.Range("A:B").Delete
.Range("A1").Select
End With
Application.ScreenUpdating = True
End Sub
（もこな２） 2024/01/29(月) 04:00:16
高速化が出来て十分な成果だと嬉しく思っています。
ポイントは、
如何にセルへの書き出しを少なくする手法を思いつくかだと教えていただきました。
言うがやすしで中々知識が追いつきませんがこれからも頑張ります。
お世話になりました。
（おぐり） 2024/01/29(月) 08:26:12
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.