Неправильная сортировка файлов в макросе

[Ice]

Здравствуйте, помогите, пожалуйста)

Есть папка, в ней лежит файл ексель + разные файлы .txt. Макрос берёт файлы по типу 1п.txt, 2п.txt и так далее и извлекает определённые данные из этих файлов. Все работает верно.
Но почему-то макрос берёт сначала 10п.txt, потом 11п.txt и так далее, а только после этого 1п.txt, 2п.txt. Видимо он как-то у себя сортирует их по-другому, нашёл костыль, если добавить 0, перед цифрами, то работает верно 01п.txt идёт первым, 10п.txt - десятым.
Может кто-то подскажет как исправить это? Чтобы файлы входили именно по порядку от 1,2,3 и так далее.

[Администратор]

Встроенного решения этой проблемы нет.

Вы смотрите файлы в какой-либо программе, например, в программе "Проводник".
Это именно программа "Проводник" сортирует файлы так, как вам удобно. А не вся система программирования так сортирует.

Система программирования расценивает имена файлов как текст, а при сортировке текста 10 меньше 2, поэтому файл "10.txt" будет выше, чем файл "2.txt".

Т.е. вам надо что-то придумать:
1) или в имена файлов добавлять спереди нули;
2) или добавить какой-нибудь функционал в макрос, который бы сам сортировал файлы так, как вы их видите в программе "Проводник" или в какой-либо другой программе. В самом VBA нет функционала, который бы делал сортировку. Т.е. вам нужно искать в интернете код по сортировке или же использовать сортировку эксель-листа.

[Ice]

Спасибо большое за ответ!

Со вторым вариантом не вышло, возможно моих знаний не хватает, чтобы написать такой код.

Случайно не знаете, через что лучше добавлять нули? Может ли макрос excel воздействовать на файлы Windows?

[Администратор]

Цитата:
Со вторым вариантом не вышло, возможно моих знаний не хватает, чтобы написать такой код.

Вам надо в интернете просто найти какой-нибудь код по сортировке, а затем его адаптировать в свой макрос.
Вам подойдёт любой способ сортировки, т.к. обычно файлов немного и любой способ сортировки будет работать быстро.

Цитата:
Может ли макрос excel воздействовать на файлы Windows?

Приведите пример воздействия.

Цитата:
Случайно не знаете, через что лучше добавлять нули?

С помощью функции Format удобно добавить нули:

Макрос

Sub Макрос()
   
    Dim ИмяФайла As String, Имя As String, Расш As String
   
   
    ' Записываем имя файла в переменную, чтобы в коде не писать имя файла несколько раз.
    ИмяФайла = "1.txt"
   
    ' Разбиваем имя на две части по последней точке.
    Имя = Left(ИмяФайла, InStrRev(ИмяФайла, ".") - 1)
    Расш = Mid(ИмяФайла, InStrRev(ИмяФайла, "."))
   
    ' Добавляем к числу спереди ноль.
    Имя = Format(Имя, "00")
   
    ' Соединяем имя и расширение обратно.
    ИмяФайла = Имя & Расш
   
    ' Смотрим, что получилось в View - Immediate Window.
    Debug.Print ИмяФайла
   
End Sub

[свернуть]

[Администратор]

Написал вам два письма на почту с заголовком "Письмо с Форума по VBA, Excel и Word". Написал именно на почту, а не на форум.

[Ice]

Воздействия, например с помощью макроса в excel изменять названия реальных файлов в папке.

[Администратор]

Да, с помощью макроса можно изменить имена файлов.

[Ice]

Попробовал сделать функцию для сортировки файлов перед их входом в макрос, но все равно сортируется так как ему надо, файлы с 1п.txt до 11п.txt, сначала идет 10п, потом 11п только потом 1п, 2п и т.д.

Может подскажите что не так может быть?

[Администратор]

Макрос

Sub п()

    Dim TextLine As String
    Dim cellRef As Range
    Set cellRef = Selection.Cells(1, 1)
   
    Dim filePath As String
    filePath = ThisWorkbook.Path & "\*п.txt"
    Dim fileName
    ReDim Files(0 To 0) As String
    fileName = Dir(filePath)
    While fileName <> ""
        Files(UBound(Files)) = fileName
        ReDim Preserve Files(0 To UBound(Files) + 1)
        fileName = Dir
    Wend
    ReDim Preserve Files(0 To UBound(Files) - 1)
    Files = SortArrayWithNumbers(Files)
   
    For Each fileName In Files
        Dim newRange As Range
        Set newRange = cellRef.Offset(1, 0).Resize(7, 1)
       
        Open ThisWorkbook.Path & "\" & fileName For Input As #1
       
        Dim i As Integer
        i = 1
        Do While Not EOF(1)
            Line Input #1, TextLine
            If i >= 9 And i <= 15 Then
            Dim values() As String
            values = Split(TextLine, vbTab)
           
            newRange.Cells(i - 8, 1).Value = values(1)
            End If
            i = i + 1
        Loop
       
        Close #1
       
        Set cellRef = cellRef.Offset(10, 0)
    Next fileName
End Sub

Function SortArrayWithNumbers(arr() As String) As String()
    Dim i As Long
    Dim j As Long
    Dim temp As String
    Dim arr1() As String
    Dim arr2() As Long
   
    ReDim arr1(LBound(arr) To UBound(arr))
    ReDim arr2(LBound(arr) To UBound(arr))
   
    For i = LBound(arr) To UBound(arr)
        arr1(i) = arr(i)
        arr2(i) = Val(Replace(arr(i), ".", ","))
    Next i
   
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr2(i) > arr2(j) Then
                temp = arr1(i)
                arr1(i) = arr1(j)
                arr1(j) = temp
               
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
               
                temp = arr2(i)
                arr2(i) = arr2(j)
                arr2(j) = temp
            End If
        Next j
    Next i
   
    SortArrayWithNumbers = arr1
End Function

[свернуть]

[Ice]

Не заметил еще, что Вы изменили, но походу работает, спасибо большое!
В понедельник еще проверю и отвечу Вам на почту.

[Администратор]

В этой строке:
ReDim Files(0 To 0) As String
добавил тип данных String, так как в процедуре SortArrayWithNumbers у массива "arr" тип данных String:
Function SortArrayWithNumbers(arr() As String) As String()

В этой строке:
Dim fileName
сделал тип данных Variant (если тип не указывается, то применяется Variant), т.к. для цикла по массиву у переменной должен быть тип данных Variant.

И ещё сделал объявление переменной:
Dim TextLine As String
Это не обязательно делать, я просто сделал, чтобы было.