Results of 1 - 1 of about 1385 for ������������ #N/A (0.016 sec.)
- [[20240127115631]]
- #score: 6930
- @digest: 6ba31bdc5620ffbfebc1eb6205e8f747
- @id: 96062
- @mdate: 2024-01-28T23:26:12Z
- @size: 17340
- @type: text/plain
- #keywords: intfree (134805), processtime (70856), strsplit (65599), varfilename (65589), csvfilename (56786), arrline (44285), endtime (31934), 験用 (27756), strline (27595), strrec (24283), starttime (23154), 的配 (9683), 用2 (8849), クォ (8796), dict (7970), 二次 (7701), 1048576 (7135), 実験 (6026), input (5948), ーテ (5555), 元配 (5299), sh1 (4875), csv (4728), 2024 (4594), 次元 (4492), 高速 (4118), double (3634), 配列 (3608), replace (2898), numberformatlocal (2884), ーシ (2852), ンマ (2635)
- 『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"" のように”(クォーテーションマーク)が前後に2つずつあります。 結合時の”(クォーテーションマーク)は必要ないので削除したいのですがどうしたら良いでしょうか ? 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 ---- 横からですが何点か ■1 ＞13:51:12のコードは、あまりにも無駄な事を行っていると ＞自分りに思えたので見直しました。 気づかれたのかわかりませんが、最初のコードの時間がかかっているのは、必要のないセルを含めて1セルずつ書き出し処理をしていたためでしょう。 ■2 ＞一度書き出した値（A,B列）を配列に入れて ＞B&AでA列に再度書き出すと言う ＞苦肉の策ですが 「■1」に関連しますが、（1行ずつ）書き出す前に結合処理をすると考えてみてはどうでしょうか? すなわちこんな感じです。 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, ",") 'カンマ区切りで配列へ '▼結合してから（1行ずつ）書き出し ActiveSheet.Cells(i + 1, "A").Value = strSplit(1) & strSplit(0) i = i + 1 Loop Close #intFree End Sub ■3 ＞記事にある ＞Replace(strLine, """", "") ＞を嚙ますことでダブルクォーテーションが外れて思ったような表示になりました。 そちらは、【Replace関数】ですが、【Replaceメソッド】であれば、出力後の結果（セル範囲）を対象に一括して処理ができます。 元データの量や内容が分からないので、どちらが早いかわかりませんが研究してみてはどうでしょうか? ■4 データ量によりますが、「■2」のように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 （もこな2） 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 （もこな2） 2024/01/28(日) 12:18:36 ---- 前回の回答で動的配列を利用するとしましたが、静的配列でいいですね。 動的配列は1時限目(行数)は拡張できないので。 静的配列でシートの最大行数分のサイズを確保しておきます。 と投稿しようと思ったら、すでにもこな2さんがそのままの回答してました。 最後の代入部分は下記でいいかな。 With ActiveSheet.Range("A1").Resize(i - 1) .NumberFormatLocal = "@" .Value = 二次元配列 .Replace What:="""", Replacement:="" End With i - 1 がCSV行数になるのでそのサイズのセル範囲に代入でいいかと。 （hatena） 2024/01/28(日) 12:25:25 ---- もこな2さん、hatenaさん コードをありがとうございます。 EmEditorでCSVのダブルクォーテーションを削除したCSVファイルに再構成して保存した CSVファイルをターゲットにするようにしたので Replace(strLine, """", "")を噛ますのを止めました。 （これで処理時間が大幅に変わる事は無いでしょうが) 検証結果、実験用1,実験用2 共に最後の行まで出力されました。 処理時間 おぐり 49秒 実験用1 52秒 実験用2 9.5秒 Resize(1048576) 実験用2 9.0秒 Resize(i-1) 実験用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 ---- 少し話が変わってしまいますが、既に述べたように時間がかかる要素の大半は、1セル（行）ずつ書き込む部分だとおもいますから、そこさえクリアすれば、一旦セルに書き出して処理すると考え方もそこまで悪い手ではないとおもいます。 したがって、配列とかよくわからないし、多少時間がかかってもよいので配列を使わずに（意識せずに）何とかしたいということであれば、↓のように極力【一気に処理する】ことを考えるだけでも、それなりの改善になったと思います。 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 （もこな2） 2024/01/29(月) 04:00:16 ---- 皆さん、改善のコードをありがとうございます。 高速化が出来て十分な成果だと嬉しく思っています。 ポイントは、 如何にセルへの書き出しを少なくする手法を思いつくかだと教えていただきました。 言うがやすしで中々知識が追いつきませんがこれからも頑張ります。 お世話になりました。 （おぐり） 2024/01/29(月) 08:26:12
... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202401/20240127115631.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97045 documents and 608224 words.
訪問者：