VBA для загрузки очень большого файла за один раз (без буферизации)

Я испытываю неожиданное ограничение vb на размер строки max, как объясняется в этом сообщении: неожиданный охват VBA от ограничения размера строки

Хотя я ожидал, что смогу загрузить файлы до 2 ГБ (2 ^ 31 символ), используя open path for binary и функции get , я получаю ошибку из строкового пространства, когда пытаюсь загрузить строку размером более 255 918 061 символа.

Мне удалось обойти эту проблему, буферизуя входной поток get . Проблема в том, что мне нужно загрузить файл в виде массива строки, разделив буфер на символы vbCrLf .

Для этого необходимо построить массив по строкам. Более того, поскольку я не могу быть уверен, заканчивается ли буфер на линии прерывания или нет, мне нужны дополнительные операции. Это решение – время и память . Загрузка файла размером 300 МБ с помощью этого кода стоит 900 МБ (!) Использования памяти excel. Есть ли лучшее решение ?

Вот ниже мой код:

 Function Load_File(path As String) As Variant Dim MyData As String, FNum As Integer Dim LenRemainingBytes As Long Dim BufferSizeCurrent As Long Dim FileByLines() As String Dim CuttedLine As Boolean Dim tmpSplit() As String Dim FinalSplit() As String Dim NbOfLines As Long Dim LastLine As String Dim count As Long, i As Long Const BufferSizeMax As Long = 100000 FNum = FreeFile() Open path For Binary As #FNum LenRemainingBytes = LOF(FNum) NbOfLines = FileNbOfLines(path) ReDim FinalSplit(NbOfLines) CuttedLine = False Do While LenRemainingBytes > 0 MyData = "" If LenRemainingBytes > BufferSizeMax Then BufferSizeCurrent = BufferSizeMax Else BufferSizeCurrent = LenRemainingBytes End If MyData = Space$(BufferSizeCurrent) Get #FNum, , MyData tmpSplit = Split(MyData, vbCrLf) If CuttedLine Then count = count - 1 tmpSplit(0) = LastLine & tmpSplit(0) For i = 0 To UBound(tmpSplit) If count > NbOfLines Then Exit For FinalSplit(count) = tmpSplit(i) count = count + 1 Next i Else For i = 0 To UBound(tmpSplit) If count > NbOfLines Then Exit For FinalSplit(count) = tmpSplit(i) count = count + 1 Next i End If Erase tmpSplit LastLine = Right(MyData, Len(MyData) - InStrRev(MyData, vbCrLf) - 1) CuttedLine = Len(LastLine) > 1 LenRemainingBytes = LenRemainingBytes - BufferSizeCurrent Loop Close FNum Load_File = FinalSplit Erase FinalSplit End Function 

Если функция FileNbOfLines эффективно возвращает количество символов разрыва строки.

Редактировать:

Мои потребности:

  1. Поиск определенной строки в файле
  2. Чтобы получить определенное количество строк, следующих за этой строкой

Здесь вы идете, не очень, но должны дать вам общую концепцию:

 Sub GetLines() Const fileName As String = "C:\Users\bloggsj\desktop\testfile.txt" Const wordToFind As String = "FindMe" Dim lineStart As String Dim lineCount As String Dim linesAfterWord As Long With CreateObject("WScript.Shell") lineCount = .Exec("CMD /C FIND /V /C """" """ & fileName & """").StdOut.ReadAll lineStart = Split(.Exec("CMD /C FIND /N """ & wordToFind & """ """ & fileName & """").StdOut.ReadAll, vbCrLf)(2) End With linesAfterWord = CLng(Trim(Mid(lineCount, InStrRev(lineCount, ":") + 1))) - CLng(Trim(Mid(lineStart, 2, InStr(lineStart, "]") - 2))) Debug.Print linesAfterWord End Sub 

Использует CMD для подсчета количества строк, затем найдите строку, на которой появляется слово, а затем вычитает один из другого, чтобы дать вам количество строк после того, как слово было найдено.

Ответ: Да, использование ReadAll из FSO должно выполнять эту работу.

Лучший ответ: просто избегайте этого!

Мои потребности были:

  1. Определить определенную строку в файле
  2. Извлеките определенное количество строк после этой строки

Насколько вам точно известно точное количество данных, которые вы хотите извлечь, и предполагая, что этот объем данных ниже предела размера строки vba (!), Вот что он делает работу быстрее.

Уменьшение времени вычислений улучшается с помощью двоичного сравнения строк. Мой код выглядит следующим образом:

 Function GetFileLines(path As String, str As String, NbOfLines As Long) As String() Const BUFSIZE As Long = 100000 Dim StringFound As Boolean Dim lfAnsi As String Dim strAnsi As String Dim F As Integer Dim BytesLeft As Long Dim Buffer() As Byte Dim strBuffer As String Dim BufferOverlap As String Dim PrevPos As Long Dim NextPos As Long Dim LineCount As Long Dim data As String F = FreeFile(0) strAnsi = StrConv(str, vbFromUnicode) 'Looked String lfAnsi = StrConv(vbLf, vbFromUnicode) 'LineBreak character Open path For Binary Access Read As #F BytesLeft = LOF(F) ReDim Buffer(BUFSIZE - 1) 'Overlapping buffer is 3/2 times the size of strBuffer '(two bytes per character) BufferOverlap = Space$(Int(3 * BUFSIZE / 4)) StringFound = False Do Until BytesLeft = 0 If BytesLeft < BUFSIZE Then ReDim Buffer(BytesLeft - 1) Get #F, , Buffer strBuffer = Buffer 'Binary copy of bytes. BytesLeft = BytesLeft - LenB(strBuffer) Mid$(BufferOverlap, Int(BUFSIZE / 4) + 1) = strBuffer 'Overlapping Buffer If Not StringFound Then 'Looking for the the string PrevPos = InStrB(BufferOverlap, strAnsi) 'Position of the looked string within the buffer StringFound = PrevPos <> 0 If StringFound Then strBuffer = BufferOverlap End If If StringFound Then 'When string is found, loop until NbOfLines Do Until LineCount = NbOfLines NextPos = InStrB(PrevPos, strBuffer, lfAnsi) If NextPos = 0 And LineCount < NbOfLines Then 'Buffer end reached, NbOfLines not reached 'Adding end of buffer to data data = data & Mid$(StrConv(strBuffer, vbUnicode), PrevPos) PrevPos = 1 Exit Do Else 'Adding New Line to data data = data & Mid$(StrConv(strBuffer, vbUnicode), PrevPos, NextPos - PrevPos + 1) End If PrevPos = NextPos + 1 LineCount = LineCount + 1 If LineCount = NbOfLines Then Exit Do Loop End If If LineCount = NbOfLines then Exit Do Mid$(BufferOverlap, 1, Int(BUFSIZE / 4)) = Mid$(strBuffer, Int(BUFSIZE / 4)) Loop Close F GetFileLines = Split(data, vbCrLf) End Function 

Чтобы еще больше вычислить время вычисления, настоятельно рекомендуется использовать быструю конкатенацию строк, как описано здесь .

Например, можно использовать следующую функцию:

 Sub FastConcat(ByRef Dest As String, ByVal Source As String, ByRef ccOffset) Dim L As Long, Buffer As Long Buffer = 50000 L = Len(Source) If (ccOffset + L) >= Len(Dest) Then If L > Buffer Then Dest = Dest & Space$(L) Else Dest = Dest & Space$(Buffer) End If End If Mid$(Dest, ccOffset + 1, L) = Source ccOffset = ccOffset + L End Sub 

Затем используйте функцию следующим образом:

 NbOfChars = 0 Do until... FastConcat MyString, AddedString, NbOfChars Loop MyString = Left$(MyString,NbOfChars) 
Interesting Posts

Сравнение производительности Apache POI и Excel VBA

Excel: суммирование элементов строки, если определенный элемент строки является конкретным именем

Получить длину десятичных знаков

Excel. Поиск n-го дня определенного месяца с любого дня года.

Получить формулу ячейки, а не результат

Excel. Сопоставьте ячейки, которые содержат точное соответствие из списка.

интеграция python в excel с использованием pyxll … с проблемами с модулем lxml

Наиболее эффективные способы работы с большими диапазонами Excel в C #?

MATCH и INDEX для диапазона, состоящего из нескольких столбцов

Как изменить тип сохранения из excel workbook для Excel 97-2003 в excel2010 с помощью vba?

Как включить функцию автоматического завершения в поле со списком, программируя в VBA?

vba store recordset как целочисленная переменная

Вычисление парных скользящих корреляций

Excel VLOOKUP (сумма двух значений, массив (сумма значений 1 + 2)

Microsoft.ACE.OLEDB.12.0 Получить имя рабочего листа

Давайте будем гением компьютера.