VBS/WSH/JS - [решено] [VBS] Сортировка текстовых строк с учётом директорий

shadowbat · Отправлено: **22:58, 08-01-2020** | #21

Цитата megaloman:

shadowbat, А Вы не говорили, что это VBA в Excel»

да, не уточнил, в шаблоне заголовка нет VBA, поэтому поставил VBS, а в самой теме не уточнил

Цитата megaloman:

, это сильно меняет дело. Колитесь, откуда берутся строки и куда они деваются потом. »

как упоминал выше, сравниваю дерево файлов и подкаталогов в двух похожих папках, чтобы выявить какие файлы отсутствуют, или изменены или равны.
строки берутся из FSO, который загоняет их в коллекцию простым прогоном по всему дереву (Dir не понимает юникод в именах)
далее две коллекции с деревьями объединяются, отрезается начальный каталог, убираются дубли, остаётся коллекция с уникальными строками из обеих папок (в первом сообщении первый код под фразой "Есть текстовые строки:")

Цитата megaloman:

Почему надо сохранять регистр - внутри сортировки любое лишнее действие ест много времени »

сохранять регистр необходимо, потому что регистр есть в именах файлов и изменять изначальный регистр считаю неприемлемым, тем более что конкретно это действие влияет на скорость, но 15% от пары минут это немного.
учитывать разный регистр необходимо, потому что в одной папке может быть \Folder\File1.txt , а в другой \FOLDER\file1.txt , в Windows это один и тот же путь, а при обработке строка "\Folder\File1.txt" не равна "\FOLDER\file1.txt", поэтому и сортируем через lcase, а результат выдаём в оригинальном регистре

да и к тому же этот переключатель регистра легко можно настроить.
на самом деле их два. 1. сортировка с учетом регистра (или без учета) и 2. выдача результата в оригинальном регистре или в нижнем/верхнем
это всё кому как удобнее и на метод пузырька не влияет

в данном случае, найти удобный/быстрый метод сортировки это тоже не проблема, методов сортировки много, вплоть до внешних библиотек, я всего лишь уточнил, что метод сортировки необходимо изменить на любой другой, а на какой именно уже не так важно

вообще, во всей этой теме гениальные строки с заменой слеша на Chr(0) и подстановка перед файлом Chr(1), что позволяет сортировать строки любым обычным способом, который подходит для сортировки текста и делать любую обвязку кому как удобнее, это не предмет спора вообще

megaloman · Отправлено: **23:29, 08-01-2020** | #22

shadowbat, Подозреваю, сортировка не нужна вовсе. По голому имени нельзя узнать, файлы или изменены или равны. Надо четкая постановка. Возможно, есть готовый софт для этого. И зачем при сравнении наличия файлов надо перечислять имена директорий? Почему не ограничиться только полными именами файлов?

shadowbat · Отправлено: **23:35, 08-01-2020** | #23

Цитата megaloman:

Подозреваю, сортировка не нужна вовсе. »

для сравнения технически не нужна, но визуально нужна. с таким же успехом можно сказать, что любая сортировка текста не нужна т.к. все равно найти значение в тексте можно и без сортировки

Цитата megaloman:

По голому имени нельзя узнать, файлы или изменены или равны. Надо четкая постановка. Возможно, есть готовый софт для этого. »

конечно нельзя, всё остальное и не являлось вопросом темы.
вопрос был конкретно по сортировке директорий, представленных в виде строк.
несколько разных готовых .exe софтов для сравнения двух папок, конечно, тоже существует на просторах интернета.
часто подаётся под соусом "синхронизация", что, по мне, является совершенно отдельной задачей. например существует сравнение текстовых и бинарных файлов, но не существует синхронизации файлов, потому что впихивать содержимое одного файла в другой никому не приходит в голову

Цитата megaloman:

И зачем при сравнении наличия файлов надо перечислять имена директорий? Почему не ограничиться только полными именами файлов? »

ведь существует много разных вариантов формирования списков файлов
у каких то людей/программ только файлы, у иных и файлы и папки, а может у кого-то список только папок. сортировка только файлов без учёта папок является полумерой
это как сортировать строки текста без учёта спец символов !@№;%:?, не во всех же строках они имеются, зачем их учитывать при сортировке?

Iska · Отправлено: **00:43, 09-01-2020** | #24

shadowbat, ну, вот, я как-то вполне обхожусь Far Manager'ом с парой-тройкой плагинов плюс внешним CloneSpy для покрытия всего спектра своих задач по полуавтоматическому сравнению каталогов и файлов.

Для сортировки строк, занимающей длительное время, есть смысл применять либо System.Collections.ArrayList/System.Collections.Sortedlist из .Net (возможно, потребуется однократно зарегистрировать библиотеку), либо базу данных в памяти.

iglezz · Отправлено: **00:47, 09-01-2020** | #25

Цитата shadowbat:

как упоминал выше, сравниваю дерево файлов и подкаталогов в двух похожих папках, чтобы выявить какие файлы отсутствуют, или изменены или равны.
строки берутся из FSO, который загоняет их в коллекцию простым прогоном по всему дереву (Dir не понимает юникод в именах)
далее две коллекции с деревьями объединяются, отрезается начальный каталог, убираются дубли, остаётся коллекция с уникальными строками из обеих папок »

Мне кажется, что оптимальнее будет (особенно на 70000 файлов) в процессе прогона по дереву заниматься отсевом, сортировкой и пополнением списка.

shadowbat · Отправлено: **03:40, 19-01-2020** | #26

К сожалению при выгрузке на лист есть две проблемы:
1. Chr(0) не обрабатывается, и обрезается, таким образом вместо Chr(0) Chr(1) необходимо использовать например Chr(1) Chr(2)
2. Родная сортировка Exl не учитывает символы Chr(0-31), таким образом Chr(0) и Chr(1) нужно заменить на любой другой (невстречающийся) набор печатных символов с номером >31 согласно таблице ascii, например &0& и &1& , в идеале нужно использовать любые "неправильные" символы \ / : * ? " < > |

megaloman · Отправлено: **19:41, 20-01-2020** | #27

shadowbat, Пробуйте, интересно, быстрее сортировка?

shadowbat · Отправлено: **10:26, 22-01-2020** | #28

Цитата megaloman:

Пробуйте, интересно, быстрее сортировка? »

1. в FileIn ограничение в 65536 строк. если сделать 66000 строк, то при выполнении строки RR.Value = WorksheetFunction.Transpose(Alls) на лист записываются значения #Н/Д (после ~3000-10000 ячейки, точное число зависит от суммы длин строк в FileIn)
2. в цикле For i = N1 + 1 To N2 идёт накопление и Exl ненадолго подвисает на примерно i=16000-25000 (возможно точное число зависит от конфигурации машины), если добавить строку If i Mod 1000 = 0 Then Debug.Print i , то видно как скорость печати постепенно уменьшается до (Не отвечает). при этом в диспетчере задач видно, что Exl продолжает работать и в конечном итоге отвисает. 65000 строк сортирует за 2-3 минуты, что конечно быстрее прошлого значения
3. при сохранении 65000 длинных строк со средней длиной 50 была ошибка. на строке .Write SS при работе с 65000 строками выдал "Ошибка: Run-time error '5': Invalid procedure call or argument", если строк меньше, то сохраняет нормально. если 65000 коротких (!) строк, то тоже сохраняет нормально. со средней длиной строк 30 сохранил нормально, если средняя длина строк 50, то ошибку выдает. может быть влияет не длина строк, а какие-то символы в пути, пока неизвестно

скопировал код из архива:

я200120.xlsm.rar

Код:

Sub rrr()

FileIn = "Z:\Box_In\filein.txt"
FileOut = "Z:\Box_Out\fileoutxls.txt"

Rang1 = "C2"
R1 = Range(Rang1).Row
C1 = Range(Rang1).Column

Set FSO = CreateObject("Scripting.FileSystemObject")

On Error Resume Next

With FSO.OpenTextFile(FileIn, 1, False)
    If Err.Number <> 0 Then
        MsgBox "File   " + FileIn + vbCrLf + Err.Description + "(" + CStr(Err.Number) + ")"
        WScript.Quit 2
    End If
    On Error GoTo 0

    Alls = Split(.ReadAll, vbCrLf)
    .Close
End With

N = LBound(Alls) - 1
NN = -1
For Each s In Alls
    s = Trim(s)
    If Len(s) <> 0 Then
        N = N + 1
        NN = NN + 1
        ii = InStrRev(s, "\")

        s = Mid(s, 1, ii - 1) + Replace(s, "\", "**", ii)
        s = Replace(s, "\", "*")

        Alls(N) = s
    End If
Next

Set RR = Range(Cells(R1, C1), Cells(R1 + NN, C1))
RR.Value = WorksheetFunction.Transpose(Alls)
Erase Alls

ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range(Rang1), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Лист3").Sort
    .SetRange RR
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Alls = RR

N1 = LBound(Alls, 1)
N2 = UBound(Alls, 1)

s = Alls(N1, 1)
s = Replace(Replace(s, "**", "\"), "*", "\")
Alls(N1, 1) = s
SS = s

For i = N1 + 1 To N2
    s = Alls(i, 1)
    s = Replace(Replace(s, "**", "\"), "*", "\")
    Alls(i, 1) = s
    SS = SS + vbCrLf + s
Next

RR.Value = Alls

With FSO.CreateTextFile(FileOut, True)
    .Write SS
    .Close
End With
MsgBox "Done"

End Sub

megaloman · Отправлено: **21:12, 22-01-2020** | #29

shadowbat, Происследовал затраты времени на исполнение этапов макроса. Выяснил, что накапливать очень длинную строку - это катастрофа по времени.

Вот изменённый макрос

Код:

Sub rrr()

FileIn = "Z:\Box_In\fileinRND.txt"
FileOut = "Z:\Box_Out\fileoutRND.txt"

Rang1 = "C2"        'C какой ячейки нечинаются данные
Rang1 = "D1"

TTT = Timer

R1 = Range(Rang1).Row
C1 = Range(Rang1).Column
 
With CreateObject("VBScript.RegExp")
    .Pattern = "[0-9]"
    .IgnoreCase = True
    .Global = True
    NameCol = .Replace(Rang1, "")
End With

Columns(NameCol).ClearContents

Set FSO = CreateObject("Scripting.FileSystemObject")

On Error Resume Next

With FSO.OpenTextFile(FileIn, 1, False)
    If Err.Number <> 0 Then
        MsgBox "File   " + FileIn + vbCrLf + Err.Description + "(" + CStr(Err.Number) + ")"
        WScript.Quit 2
    End If
    On Error GoTo 0

    Alls = Split(.ReadAll, vbCrLf)
    .Close
End With
On Error GoTo 0
 
N = LBound(Alls) - 1
NN = -1
For Each S In Alls
    S = Trim(S)
    If Len(S) <> 0 Then
        N = N + 1
        NN = NN + 1
        ii = InStrRev(S, "\")

        S = Mid(S, 1, ii - 1) + Replace(S, "\", Chr(42) + Chr(42), ii)
        S = Replace(S, "\", Chr(42))
        
        Alls(N) = S
    End If
Next

ReDim Alls2(1 To NN + 1, 1 To 1)
For i = 1 To NN + 1
    Alls2(i, 1) = Alls(i - 1)
Next
Erase Alls

Set RR = Range(Cells(R1, C1), Cells(R1 + NN, C1))
RR.Value = Alls2
Erase Alls2

'MsgBox "Посадили файл в таблицу (sec) " + CStr(Timer - TTT)
TTT1 = Timer

ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range(Rang1), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortTextAsNumbers
With ActiveWorkbook.ActiveSheet.Sort
    .SetRange RR
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'MsgBox "Отсортировали (sec) " + CStr(Timer - TTT1)
TTT1 = Timer

Alls = RR

'MsgBox "Забрали отсорт в массив (sec) " + CStr(Timer - TTT1)
TTT1 = Timer

N1 = LBound(Alls, 1)
N2 = UBound(Alls, 1)

With FSO.CreateTextFile(FileOut, True)
    For i = N1 To N2
        Alls(i, 1) = Replace(Replace(Alls(i, 1), Chr(42) + Chr(42), "\"), Chr(42), "\")
        If i < N2 Then
            .WriteLine Alls(i, 1)
        Else
            .Write Alls(i, 1)
        End If
    Next
    .Close
End With

RR.Value = Alls
'MsgBox "Done (sec) " + CStr(Timer - TTT1) + "    (" + CStr(Timer - TTT) + ")"
MsgBox "Done (sec) " + CStr(Timer - TTT)

End Sub

Sub GenOut()
    FileOut = "Z:\Box_In\fileinRND.txt"
    NRepeat = 2000
    
    TTT = Timer
    
    Dim Sim(61)
    
    S = ""
    i = 0
    For j = 1 To 3
        If j = 1 Then k1 = 48: k2 = 57
        If j = 2 Then k1 = 65: k2 = 90
        If j = 3 Then k1 = 97: k2 = 122
        
        For k = k1 To k2
            Sim(i) = Chr(k)
            S = S + Sim(i) '+ vbCrLf
            i = i + 1
        Next
    Next
    
    
Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO.CreateTextFile(FileOut, True)
    
    For i = 1 To NRepeat
            ''''''''''  MsgBox sRND(1, 5, Sim)  ' 1,5 - диапазон кол-ва симв в сформир строке; Sim - масс символов
        If (i - 1) Mod 100 = 0 Then sTotal = "\" + sRND(6, 8, Sim) + ".txt" Else sTotal = ""
        S1 = sRND(3, 5, Sim)
        S2 = sRND(3, 5, Sim)
        S3 = sRND(3, 5, Sim)

        T1 = sRND(2, 5, Sim) + ".txt"
        T2 = sRND(2, 5, Sim) + ".txt"
        T3 = sRND(2, 5, Sim) + ".txt"
    
        sTotal = sTotal + vbCrLf + "\" + S1 + "\" + S2 + "\" + S3 + "\" + T1
        sTotal = sTotal + vbCrLf + "\" + S1 + "\" + S2 + "\" + S3 + "\" + T2
        sTotal = sTotal + vbCrLf + "\" + S1 + "\" + S2 + "\" + S3 + "\" + T3
        
        sTotal = sTotal + vbCrLf + "\" + S2 + "\" + S3 + "\" + S1 + "\" + T1
        sTotal = sTotal + vbCrLf + "\" + S2 + "\" + S3 + "\" + S1 + "\" + T2
        sTotal = sTotal + vbCrLf + "\" + S2 + "\" + S3 + "\" + S1 + "\" + T3
        
        sTotal = sTotal + vbCrLf + "\" + S3 + "\" + S1 + "\" + S2 + "\" + T1
        sTotal = sTotal + vbCrLf + "\" + S3 + "\" + S1 + "\" + S2 + "\" + T2
        sTotal = sTotal + vbCrLf + "\" + S3 + "\" + S1 + "\" + S2 + "\" + T3
        
        sTotal = sTotal + vbCrLf + "\" + S1 + "\" + S2 + "\" + S3 + "\"
        sTotal = sTotal + vbCrLf + "\" + S2 + "\" + S3 + "\" + S1 + "\"
        sTotal = sTotal + vbCrLf + "\" + S3 + "\" + S1 + "\" + S2 + "\"
         
        sTotal = sTotal + vbCrLf + "\" + S1 + "\" + S2 + "\" + T1
        sTotal = sTotal + vbCrLf + "\" + S1 + "\" + S2 + "\" + T2
        sTotal = sTotal + vbCrLf + "\" + S1 + "\" + S2 + "\" + T3
        
        sTotal = sTotal + vbCrLf + "\" + S2 + "\" + S3 + "\" + T1
        sTotal = sTotal + vbCrLf + "\" + S2 + "\" + S3 + "\" + T2
        sTotal = sTotal + vbCrLf + "\" + S2 + "\" + S3 + "\" + T3
        
        sTotal = sTotal + vbCrLf + "\" + S3 + "\" + S1 + "\" + T1
        sTotal = sTotal + vbCrLf + "\" + S3 + "\" + S1 + "\" + T2
        sTotal = sTotal + vbCrLf + "\" + S3 + "\" + S1 + "\" + T3
        
        sTotal = sTotal + vbCrLf + "\" + S1 + "\" + S2 + "\"
        sTotal = sTotal + vbCrLf + "\" + S2 + "\" + S3 + "\"
        sTotal = sTotal + vbCrLf + "\" + S3 + "\" + S1 + "\"
       
        sTotal = sTotal + vbCrLf + "\" + S1 + "\" + T1
        sTotal = sTotal + vbCrLf + "\" + S1 + "\" + T2
        sTotal = sTotal + vbCrLf + "\" + S1 + "\" + T3
        
        sTotal = sTotal + vbCrLf + "\" + S2 + "\" + T1
        sTotal = sTotal + vbCrLf + "\" + S2 + "\" + T2
        sTotal = sTotal + vbCrLf + "\" + S2 + "\" + T3
        
        sTotal = sTotal + vbCrLf + "\" + S3 + "\" + T1
        sTotal = sTotal + vbCrLf + "\" + S3 + "\" + T2
        sTotal = sTotal + vbCrLf + "\" + S3 + "\" + T3
        
        sTotal = sTotal + vbCrLf + "\" + S1 + "\"
        sTotal = sTotal + vbCrLf + "\" + S2 + "\"
        sTotal = sTotal + vbCrLf + "\" + S3 + "\"
        .WriteLine sTotal
    Next
    .Close
End With
MsgBox "Done (sec) " + CStr(Timer - TTT)

End Sub

Function nRND(min1, max1)
    nRND = Int((max1 - min1 + 1) * Rnd + min1)
End Function

Function sRND(min1, max1, SSS)
    nSim = UBound(SSS)
    sRND = ""
    For j = 1 To nRND(min1, max1)
        sRND = sRND + SSS(nRND(0, nSim))
    Next
End Function

Макрос берёт в массив текстовый файл с прописанными в нём путями, помещает данные в таблицу, в таблице сортирует, записывает в выходной файл. Переписал транспонирование массива - Excel не справлялся.

Был вынужден сделать макрос для генерации текстового файла со случайными путями - надо было на чём-то измываться. Он выделен зелёным - он нужен, чтобы сфабриковать исходный файл для обработки, собственно для обработки файла он не нужен. Он формирует 72019строк (при значении параметра NRepeat = 2000)
Если заархивируете и отдадите свой файл - поизмываюсь и над ним.

Iska · Отправлено: **21:42, 22-01-2020** | #30

Цитата megaloman:

Выяснил, что накапливать очень длинную строку - это катастрофа по времени. »

Угу. Память хоть и оперативная, но сотни тысяч операций конкатенации строк (а это, фактически — выделение новой памяти; создание в ней нового экземпляра строки — даже если используется одна и та же переменная к коде; освобождение памяти, занятой старой строкой/строками) бывают весьма затратны на «больших» строках.