Последовательность моих действий: 1) В файле txt c помощью поиска и замены заменяю все / на /табуляция 2) Открываю новую книгу Excel и скопировав содержимое файла txt вставляю всё это в Excel 3) В итоге у меня создается 1000 строк и 6 колонок 4) Выделяю первую строки и с помощью ПКМ >Вставить создаю новую пустую строку 5) Выделяю первых 6 колонок этой строки и включаю функцию Фильтр 6) Теперь я могу сортировать по возрастанию все строки, ориентируясь на шестую колонку, в которой содержаться числа 7) Нужный результат выделяю и копирую в файл txt 8) С помощью поиска и замены удаляю всю табуляцию и вот все ссылки отсортированы так, ка мне надо. Пример результата: https://mysite.com/file/ayywfybnywxn/1465935 https://mysite.com/file/nxhhrszispxv/3776491 https://mysite.com/file/omvyecfnqaco/4975784 https://mysite.com/file/wbmvseojgocd/4992568 https://mysite.com/file/wbmvseojgocd/9469743
В данном случае я использую Excel, как инструмент для сортировки строк. Проблема в том, что иногда в файле txt содержится несколько миллионов строк!
Вопрос: как в данном случае я могу отсортировать строки? Попробовал использовать Power Pivot и вроде бы всё работает: импорт данных происходит успешно, с колонками и строками тоже всё в порядке, сортировка работает отлично, но не понимаю, как мне сохранить полученный результат. Сохраняются пустые файлы и больше ничего. Возможно есть другие способы решения моей задачи?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
georgmann, зависит от оперативной памяти - если хватит, то отсортировать массив из 5 млн элементов должно меньше чем за минуту, но тут всё от железа зависит Пробуйте
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
тогда у вас 2 варианта: 1. создать тему в платной ветке. Там всё сделают за вас, только платите 2. самому сортировать с помощью PQ, Access, SQL или чем-либо другим (что для вас НЕ тёмный лес)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
привет)) ну почему же? VBA Excel вполне в состоянии открыть txt, отсортировать в памяти и записать обратно
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Разобрался! Access мне вполне достаточно. Там есть функция "Экспорт", которой я изначально просто не видел! Как всё банально просто! Ещё раз спасибо всем за помощь и участие! А БМВ за хорошую наводку!
Jack Famous написал: VBA Excel вполне в состоянии открыть txt
именно по этому я и говорю, что Excel не при делах. процедуру можно выполнить в любом приложении поддерживающем VBA, а если так, то и просто VBS скрипта будет достаточно, да еще бонусом пойдет использование аргументов и возможность просто перетащить файл txt на файл VBS и получить результат. Как правильно отметил Андрей, PowerShell еще мощнее, хотя не всегда понятен, но CMDLETы есть на столько мощные , что оправдывают слово Power на все 100%.
БМВ написал: процедуру можно выполнить в любом приложении поддерживающем VBA
А где ещё ТС надут алгоритмщиков, как не на форуме по Excel? Сюда толпами за решением экономических, логистических и прочих задач ходят, причём включая именно и решение задачи, а уж Excel весьма и весьма опосредовано - просто другими средами не интересуются или на других форумах от ворот поворот. Люди ж не любят думать - просто хотят на блюдечке с голубой каёмочкой поиметь и совершенно бесплатно
в случае переполнения памяти, Excel можно использовать для предварительной выгрузки/хранения блоков при сортировке)) Но это уже, конечно, совсем костыль))
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
64 битная версия - и нет проблем. На строках, подобных примеру ТСа, в файле: кодировка ANSI, переносы строк VbCrLf для 5000000 строк макрос
Скрытый текст
Код
Public Sub ReorderUrls()
Const inputName = "c:\path\urls.txt"
Const outputName = "c:\path\ordered_urls.txt"
Dim subStrs(0 To 10000000) As String, strData As String, i As Long
Dim pRSet As Object, fNum As Integer, ft As Single
ft = Timer
Set pRSet = CreateObject("ADODB.Recordset")
pRSet.CursorLocation = 3
pRSet.Fields.Append "value", 3
pRSet.Fields.Append "rodid", 3
pRSet.Open
fNum = FreeFile: i = -1
Open inputName For Input As #fNum
Do Until EOF(fNum)
Line Input #fNum, strData
If Trim$(strData) <> "" Then
i = i + 1
subStrs(i) = strData
pRSet.AddNew
pRSet(0).Value = CLng(Mid$(strData, InStrRev(strData, "/") + 1))
pRSet(1).Value = i
End If
Loop
pRSet.Sort = "value"
pRSet.MoveFirst
fNum = FreeFile
Open outputName For Output As #fNum
Do Until pRSet.EOF
Print #fNum, subStrs(pRSet(1).Value)
pRSet.MoveNext
Loop
Close #fNum
Debug.Print "Full time: " & Timer - ft
End Sub
отработал за 54 секунды, отъедая около 1,2 Гигабайта памяти, что в современных условиях не смертельно, лишь бы Excel был 64 бита
georgmann, можете дать ваш исходный файл (замените домен, если нужно)? Хочу потестить…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Версия Андрея VG из #19 за 62 сек выдала ошибку Type mismatch на строке кода pRSet(0).Value = CLng(Mid$(strData, InStrRev(strData, "/") + 1)) после строки "subStrs(3880285) : https://photodune.net/item/teddy-bear-hung-out-to-dry/12180928/support" и счётчике i = 3 882 285 — псоле последнего слэша в этой строке текст "support", а должно быть число. Необходимо вводить дополнительные проверки…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
georgmann: не указал что числа, которые находятся после последнего слеша, разной длины
не совсем - Андрей берёт всё после последнего слэша и преобразует в целое число функцией CLng(), а в этой строке у вас после последнего слэша идёт "support" - вот и всё
Андрей Лящук, спасибо! Сможете прикрутить свою версию к тестовому файлу?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Прикрутил доп. проверку и подключил ADODB через ссылки - у меня отработало за 89 секунд без проблем
Коды
Код
Option Explicit
Option Private Module
Const inputName = "C:\!TEST\TestSort.txt"
Const outputName = "C:\!TEST\TestSort_Sort.txt"
'===========================================================================================
Sub Test()
Dim t!
t = Timer
ReorderUrls
Debug.Print Format(Timer - t, "0 сек")
End Sub
'===========================================================================================
Sub ReorderUrls()
Dim pRSet As New ADODB.Recordset, fNum%
Dim x, subStrs(10000000) As String, strData$, i&, f&
pRSet.CursorLocation = 3
pRSet.Fields.Append "value", 3
pRSet.Fields.Append "rodid", 3
pRSet.Open
fNum = FreeFile: i = -1
Open inputName For Input As #fNum
Do Until EOF(fNum)
Line Input #fNum, strData
If Trim$(strData) <> "" Then
i = i + 1
subStrs(i) = strData
pRSet.AddNew
rep: f = InStrRev(strData, "/")
x = Mid$(strData, f + 1)
If Not IsNumeric(x) Then strData = Left(strData, f - 1): GoTo rep
pRSet(0).Value = --x
pRSet(1).Value = i
End If
Loop
pRSet.Sort = "value"
pRSet.MoveFirst
fNum = FreeFile
Open outputName For Output As #fNum
Do Until pRSet.EOF
Print #fNum, subStrs(pRSet(1).Value)
pRSet.MoveNext
Loop
Close #fNum
End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
georgmann написал: Да, такое случайно может попасться.
Но показывать такое в примере я такого не буду, чтобы не нарушать девиз - Моя голова чужим рукам покоя не даёт! Поэтому даже извинятся не буду - ещё один девиз - Пустяки, дело-то житейское! Добавим регулярок чуток. Время подросло до 76 секунд.
Скрытый текст
Код
Public Sub ReorderUrls()
Const inputName = "c:\path\urls.txt"
Const outputName = "c:\path\ordered_urls.txt"
Dim subStrs(0 To 10000000) As String, strData As String, i As Long
Dim pRSet As Object, fNum As Integer, ft As Single
Dim pReg As Object, pItems As Object
Set pReg = CreateObject("VBScript.RegExp")
pReg.Pattern = "\d+": pReg.Global = True
ft = Timer
Set pRSet = CreateObject("ADODB.Recordset")
pRSet.CursorLocation = 3
pRSet.Fields.Append "value", 3
pRSet.Fields.Append "rodid", 3
pRSet.Open
fNum = FreeFile: i = -1
Open inputName For Input As #fNum
Do Until EOF(fNum)
Line Input #fNum, strData
Set pItems = pReg.Execute(strData)
If pItems.Count > 0 Then
i = i + 1
subStrs(i) = strData
pRSet.AddNew
pRSet(0).Value = CLng(pItems(pItems.Count - 1).Value)
pRSet(1).Value = i
End If
Loop
pRSet.Sort = "value"
pRSet.MoveFirst
fNum = FreeFile
Open outputName For Output As #fNum
Do Until pRSet.EOF
Print #fNum, subStrs(pRSet(1).Value)
pRSet.MoveNext
Loop
Close #fNum
pRSet.Close
Debug.Print "Full time: " & Timer - ft
End Sub
Андрей VG, а запусти мой вариант твоего решения - сколько будет? Мне кажется, что строковые должны выиграть + такие моменты скорее исключения, чем правило
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄