Есть текст, разбросанный на несколько ячеек исключительно вертикально, который нужно в итоге собрать в одну ячейку. И так около 10млн раз.
Код написанный мной - ниже. Он объединяет текст активной ячейки с текстом в ячейке прямо под ней. Удаляет нижнюю строку из которой он только что взял текст в активную ячейку. Проверяет нижнюю ячейку на условие налчие определенного набора символов и дальше решает нужно ли ему объединять текст, или переходить к следующей ячейке и объединять уже в нее. Ну и потом обратно прыгает в начал цикла Do.
Проблема в том, что массив данных огромный. 6 CSV файлов на 1,6 гига.
Заранее огромное спасибо за вашу помощь.
PS. Не судите строго - пишу код кустарно, но для офисных нужно всегда хватало
Код
Sub Palantir()
Application.ScreenUpdating = False
Line1:
Do
ActiveCell = ActiveCell & " " & ActiveCell.Offset(1, 0)
ActiveCell.Offset(1, 0).Delete Shift:=xlUp
Loop Until _
InStr(1, ActiveCell.Offset(1, 0), ",AFR/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",AME/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",AMR/") <> 0 Or _
InStr(1, ActiveCell.Offset(1, 0), ",ANZ/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",AUS/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",CAM/") <> 0 Or _
InStr(1, ActiveCell.Offset(1, 0), ",EAF/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",EME/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",ESA/") <> 0 Or _
InStr(1, ActiveCell.Offset(1, 0), ",EUR/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",IOI/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",MEA/") <> 0 Or _
InStr(1, ActiveCell.Offset(1, 0), ",MED/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",NAM/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",NEM/") <> 0 Or _
InStr(1, ActiveCell.Offset(1, 0), ",NEU/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",NEZ/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",OCE/") <> 0 Or _
InStr(1, ActiveCell.Offset(1, 0), ",SAF/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",SAM/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",SEM/") <> 0 Or _
InStr(1, ActiveCell.Offset(1, 0), ",WAF/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",WME/") <> 0 Or InStr(1, ActiveCell.Offset(1, 0), ",WSA/") <> 0 Or _
InStr(1, ActiveCell.Offset(1, 0), ",FEA/") <> 0
ActiveCell.Offset(1, 0).Activate
If ActiveCell = "" Then Exit Sub
GoTo Line1
End Sub
Trixter, я название темы подкорректировал - в следующий раз сами давайте название, отражающее суть проблемы. А вот оформление кода исправьте сами: ищите такую кнопку.
Trixter написал: Проблема в том, что массив данных огромный.
вот и ответ!.. берите массив, а не поячеечно... создайте доп лист с вашими искомыми вхождениями - с которого можно будет все искомые вхождения тоже взять в массив... дальше по обстоятельствам... НО
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
Про 10 миллионов тоже не понял, ну да ладно. Скажу по этому коду - ну вот зачем на каждом шаге 22 раза (или сколько там) лазить за данными в ячейку? Можно ведь взять данные один раз в переменную и затем анализировать её .
К сожалению, массивами пользоваться не умею. А решить задачку нужно буквально с сегодня на завтра. Плюс, вроде как общую суть массивов улавливаю, но как там работать с относительными ссылками?...
Таким инструментом, как powerQuery тоже пока не доводилось пользоваться. В общем, есть чем заняться на досуге - изучением массивов и powerQuery.
P.S. В приимере, который я приложил первая строка - названия колонок через запятую. Вторая строка - это как должно быть. Третья и последующие строки - это уже обрывки данных, которые нужно объединять в такое же, как строка номер два.
P.S.S Всего 6 CSV файлов общим размеро 1,6 гигов. Точное количество строчек, к сожалению, не скажу. Так как открывая один файл в эксель оно мне пишет, что отобразит инфо не полностью. И забивает полный лист на 1048576 строк.
P.S.S.S В итоге нужен файл, где будут все нужные данные в одной строке через запятую, чтобы потом просто использовать ф-цию text-to-columns и сделать из этого человеческую таблицу.
это же меняет суть вопроса... обрежьте файл и приложите... и ваши критерии Instr напишите на отдельном листе XL-файла... (всё общим весом не более 100 кб запакуйте и приложите в тему)...
Цитата
Trixter написал: все нужные данные в одной строке через запятую, чтобы потом просто использовать ф-цию text-to-columns
ADOStream-ом считать с файла... или читать частями и нужный массив сразу собирать, потом выгрузить на лист сразу по столбцам... НО (всё равно вопрос остаётся - влезет ли в книгу 10млн - если оно не влезет)...
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
Приложил CSV файл. Опять же. Первая строка - это через запятую название колонок.
Дальше - разброд и шатание. Данные идут через запятую, но, в какой то момент там появляется "переход на новую строку", и когда открываешь в экселе, то это уже соответственно другая ячейка.
Криетии instr: если в тексте activecell.offset(1,0) присутствует одно из значений ",AFR"....",FEA" (в оригинальном сообщении есть), то тогда это значит, что эта строчка - основа для следующей "склейки"
Ну как минимум можно читать эти csv кодом как текст построчно и сразу писать результат в другой текстовый файл, параллельно считать количество строк на выходе и по достижении 1048576 начинать выгружать в следующий файл. Затем можно эти файлы открывать в экселе сразу мастером разбивая по столбцам, если уж так оно нужно будет в Экселе А если затем в экселе не нужно - то можно строки и не считать
... приложите пример Выходных данных из вашего csv... там и видно будет, как сразу получить нужный массив... ... и ответьте на мой вопрос
Цитата
JeyCi написал: НО (всё равно вопрос остаётся - влезет ли в книгу 10млн - если оно не влезет)...
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
если просто взять csv и разбить по переходу на новую строку - это так:
Код
Sub Read_text_file()
Dim strWholeFile As String
Dim ADOStream
Set ADOStream = CreateObject("ADODB.Stream")
With ADOStream
.Charset = "utf-8"
.Mode = 3
.Type = 1
.Open
.LoadFromFile ThisWorkbook.Path & "\SEU_discharge_July.csv"
.Position = 0
.Type = 2
strWholeFile = .ReadText
.Close
End With
Set ADOStream = Nothing
arr = Split(strWholeFile, Chr(10))
End Sub
в окне Locals массив arr видите... дальше его обрабатывайте по вашей логике p.s. но нужно ли было так разбивать? (чтобы потом снова склеивать?)... покажите пример Выходных данных - нужный (по вашему файлу и вашей логике... и критерии достаньте из кода на лист) p.s. всё равно меня смущает 10млн... вариант от Hugo - как альтернатива
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
Hugo написал:я боюсь 1,6 гига так в массив не влезут
всё зависит от вашего компьютера... Hugo, простите не обратила внимания, что это ваш ответ (верю вашему опыту)... но ухожу из темы - потому что уже не раз ТСа спросила, как разбивать и надо ли?, чтобы потом снова склеивать (может и разбивать по другому?) и потому что ТС не показывает итог и не отвечает на вопросы...
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
Решение "в лоб", не меняя логику автора, но без лишних обращений к ячейкам:
Скрытый текст
Код
Sub Palantir()
Dim CurCell As String, Row As Long, NextCell As String
Application.ScreenUpdating = False
Row = 1
NextCell = Cells(Row, 1).Value
Do
CurCell = NextCell
Row = Row + 1
NextCell = Cells(Row, 1).Value
Do
CurCell = CurCell & " " & NextCell
Rows(Row).Delete Shift:=xlUp
NextCell = Cells(Row, 1).Value
Loop Until ValueTest(NextCell) Or NextCell = ""
Cells(Row - 1, 1).Value = CurCell
Loop Until NextCell = ""
Application.ScreenUpdating = True
End Sub
Function ValueTest(ByVal v As String) As Boolean
ValueTest = _
InStr(1, v, ",AFR/") <> 0 Or InStr(1, v, ",AME/") <> 0 Or InStr(1, v, ",AMR/") <> 0 Or _
InStr(1, v, ",ANZ/") <> 0 Or InStr(1, v, ",AUS/") <> 0 Or InStr(1, v, ",CAM/") <> 0 Or _
InStr(1, v, ",EAF/") <> 0 Or InStr(1, v, ",EME/") <> 0 Or InStr(1, v, ",ESA/") <> 0 Or _
InStr(1, v, ",EUR/") <> 0 Or InStr(1, v, ",IOI/") <> 0 Or InStr(1, v, ",MEA/") <> 0 Or _
InStr(1, v, ",MED/") <> 0 Or InStr(1, v, ",NAM/") <> 0 Or InStr(1, v, ",NEM/") <> 0 Or _
InStr(1, v, ",NEU/") <> 0 Or InStr(1, v, ",NEZ/") <> 0 Or InStr(1, v, ",OCE/") <> 0 Or _
InStr(1, v, ",SAF/") <> 0 Or InStr(1, v, ",SAM/") <> 0 Or InStr(1, v, ",SEM/") <> 0 Or _
InStr(1, v, ",WAF/") <> 0 Or InStr(1, v, ",WME/") <> 0 Or InStr(1, v, ",WSA/") <> 0 Or _
InStr(1, v, ",FEA/") <> 0
End Function
на полутора тысячах строк - выполнение мгновенное. Можно ускорить ещё, применив массивы и выгрузку на другой лист, чтобы не удалять строки (достаточно медленная операция)
ТСу - книга с кодом должна лежать в папке, где и csv файл... если окно Locals отсутствует - в VBEditor'e -> Tools -> Locals Window
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
Я тоже слегка изначальный код шлифанул, там ещё можно с проверкой подшаманить, но после инфы про csv думаю это всё лишнее, нужно делать как я выше написал
Код
Sub Palantir()
Dim s$, r As Range
Application.ScreenUpdating = False
Set r = ActiveCell
s = r.Offset(1, 0)
Line1:
Do
r = r & " " & s
r.Offset(1, 0).Delete Shift:=xlUp
DoEvents: DoEvents
s = r.Offset(1, 0)
If s = "" Then Exit Sub
Loop Until _
InStr(1, s, ",AFR/") <> 0 Or InStr(1, s, ",AME/") <> 0 Or InStr(1, s, ",AMR/") <> 0 Or _
InStr(1, s, ",ANZ/") <> 0 Or InStr(1, s, ",AUS/") <> 0 Or InStr(1, s, ",CAM/") <> 0 Or _
InStr(1, s, ",EAF/") <> 0 Or InStr(1, s, ",EME/") <> 0 Or InStr(1, s, ",ESA/") <> 0 Or _
InStr(1, s, ",EUR/") <> 0 Or InStr(1, s, ",IOI/") <> 0 Or InStr(1, s, ",MEA/") <> 0 Or _
InStr(1, s, ",MED/") <> 0 Or InStr(1, s, ",NAM/") <> 0 Or InStr(1, s, ",NEM/") <> 0 Or _
InStr(1, s, ",NEU/") <> 0 Or InStr(1, s, ",NEZ/") <> 0 Or InStr(1, s, ",OCE/") <> 0 Or _
InStr(1, s, ",SAF/") <> 0 Or InStr(1, s, ",SAM/") <> 0 Or InStr(1, s, ",SEM/") <> 0 Or _
InStr(1, s, ",WAF/") <> 0 Or InStr(1, s, ",WME/") <> 0 Or InStr(1, s, ",WSA/") <> 0 Or _
InStr(1, s, ",FEA/") <> 0
Set r = r.Offset(1, 0)
GoTo Line1
End Sub
Если за это браться, то необходимо вникать во все тонкости и выпускать "готовый продукт". А это разговор не то что не для этой темы, но и не для этого раздела.
тут вообще остаётся вопрос - эти все параметры нужны будут для выгрузки? (или по сути все эти поля [столбцы] и не нужны будут на листе - только выборочно?.. в придачу к вопросам по строкам)
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
вариант для файла ТСа (на 1млн остаётся предположение от Hugo - что столько в массив не влезет - тогда резать по частям, как он предлагал - можно дополнением к этому коду) ... в функцию Parse_S добавить остальные ваши Instr, которые могут встречаться... по коду ??? - помечено предположение, исходя из которого выстроена проверка на начало строки (что ID - 13 символов, и ещё 7 символов на Trade_Code)
Код
Sub ReadCSV_accKeys()
Dim strWholeFile As String
Dim ARR_keys As Variant, ARR_items As Variant, ARR_vv As Variant
Dim ADOStream, strS As String
Dim posnum As Long
Dim nr As LongThisWorkbook.Sheets(1).UsedRange.ClearContents
Set ADOStream = CreateObject("ADODB.Stream")
t = Timer
With ADOStream
'взяли общей строкой текст из файла
.Charset = "utf-8"
.Mode = 3
.Type = 1
.Open
.LoadFromFile ThisWorkbook.Path & "\SEU_discharge_July.csv"
.Position = 0
.Type = 2
strWholeFile = .ReadText
.Close
End With
a = Split(strWholeFile, Chr(10)) 'массив всех строк по символу "перехода на новую строку"
ARR_keys = Parse_S(strWholeFile, posnum) 'массив shipment_version_instance_id,trade_lane_code, находящихся в общем массиве
k = UBound(ARR_keys)
ReDim ARR_items(1 To UBound(ARR_keys))
'из массива строк подбираем диапазоны
elr = UBound(a)
ee = UBound(a)
For i = elr To 1 Step -1
If Left(a(i), 21) = ARR_keys(k) Then 'если 21 левый символ - это ID и Trade_lane Code ???
ARR_items(k) = (i) & "|" & ee
ee = i - 1
k = k - 1
End If
Next
'выгрузка по значениям границ диапазонов
ReDim ARR_vv(1 To UBound(ARR_keys) + 1, 1 To 1)
nr = 1
ARR_vv(1, nr) = a(0)
For kk = 1 To UBound(ARR_keys)
b = Split(ARR_items(kk), "|")(0): e = Split(ARR_items(kk), "|")(1)
strS = ""
For i = b To e
strS = strS & a(i) & Chr(10)
Next i
nr = nr + 1
ARR_vv(nr, 1) = Trim(strS)
Next kk
ThisWorkbook.Sheets(1).Range("A2").Resize(nr, 1).Value = ARR_vv
MsgBox Timer - t & "сек"
End Sub
Public Function Parse_S(S, i As Long) As Variant
Static RE As Object
If RE Is Nothing Then Set RE = CreateObject("vbscript.regexp")
bRes = False
Set RE = CreateObject("VBScript.RegExp")
RE.Global = True
RE.IgnoreCase = True
RE.Pattern = "(.{13}?)(?:(,FEA/|,WAF/|,NEU/|,EUR/)(.{3}?))" 'здесь добавьте ваши ВСЕ через | ... !!!
bRes = RE.test(S)
If bRes Then
Set oMatches = RE.Execute(S)
ReDim x(1 To oMatches.Count)
For i = 0 To oMatches.Count - 1
x(i + 1) = oMatches(i)
'Debug.Print x(i + 1)
Next
End If
Parse_S = x
End Function
Повторюсь - для 1млн лучше, PowerQuery!!!... но если ТС проверит этот код хотя бы на 10 000 и скажет время отработки - тоже будет интересно.. хотя если выгрузить сначала в массив, потом выложить на Лист - должно быть ПОБЫСТРЕЕ... - (перевложила файл)
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
Чисто "for fun" написал (вернее переделал один подходящий код) заготовку "парсера" из SEU_discharge_July.csv в SEU_discharge_July2.csv В процессе обнаружил что оба существующих в теме выше Palantir'а (оригинал и моя "шлифовка" не меняя алгоритм) воруют по строке, что конечно чревато... Там в результате вроде как две похожие строки - но они разные!
Код
Option Explicit
Sub FromOne2Other()
Const ForReading = 1
Const Path2IncomingFile = "c:\Temp\SEU_discharge_July.csv"
Dim f As Variant, fs As Variant, ResultFileObject, b As String, s As String, Counter As Long
Dim FlagWrite As Boolean
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(Path2IncomingFile, ForReading, False)
Set ResultFileObject = fs.CreateTextFile("c:\Temp\SEU_discharge_July2.csv", True)
'читаем и пишем шапку
s = f.readline
Counter = Counter + 1
Application.StatusBar = "Пишем строку " & Counter
ResultFileObject.WriteLine s
s = ""
'работа с телом файла
Do
b = f.readline
FlagWrite = True
Select Case True
Case InStr(b, ",AFR/")
Case InStr(b, ",AME/")
Case InStr(b, ",AMR/")
Case InStr(b, ",ANZ/")
Case InStr(b, ",AUS/")
Case InStr(b, ",CAM/")
Case InStr(b, ",EAF/")
Case InStr(b, ",EME/")
Case InStr(b, ",ESA/")
Case InStr(b, ",EUR/")
Case InStr(b, ",IOI/")
Case InStr(b, ",MEA/")
Case InStr(b, ",MED/")
Case InStr(b, ",NAM/")
Case InStr(b, ",NEM/")
Case InStr(b, ",NEU/")
Case InStr(b, ",NEZ/")
Case InStr(b, ",OCE/")
Case InStr(b, ",SAF/")
Case InStr(b, ",SAM/")
Case InStr(b, ",SEM/")
Case InStr(b, ",WAF/")
Case InStr(b, ",WME/")
Case InStr(b, ",WSA/")
Case InStr(b, ",FEA/")
Case Else
s = s & " " & b
FlagWrite = False
End Select
If FlagWrite Then
Counter = Counter + 1
Application.StatusBar = "Пишем строку " & Counter
If Not Len(s) Then s = b
ResultFileObject.WriteLine s
s = b
End If
Loop Until (f.AtEndOfStream)
f.Close
Application.StatusBar = False
End Sub
будет шевелиться побыстрее, но пропадёт контроль за процессом. Как вариант - можно в статусбар выводить только каждую сотую или например тысячную строку, это будет не так тормозить процесс.