Я пытаюсь использовать vba для сортировки вкладок в Excel, но я недостаточно знаком с написанием кода для изменения существующих ответов, которые я нашел в Интернете.

У меня есть несколько файлов Excel, каждый с разной системой нумерации. К ним относятся Item (#ofsheet), например Item (1), Item (8), Item (28). Они организуются по пунктам 1, 28 и 8, когда я пробую существующие коды, когда это должно быть 1, 8, 28.

Может ли кто-нибудь помочь мне с кодом для этого? Спасибо.

Изменить: приношу свои извинения, я изначально написал это на своем телефоне. Этот код работает для меня, чтобы получить элементы в порядке Item (1), Item (11), Item (2), Item (34).

Sub sortAscendinfg()

    Dim i, N, k As Double

    'Count the number of worksheets and store the number in variable "n"
    N = Application.Sheets.Count
    
    'Do the following look for each worksheet again
    For i = 1 To N
    
        'Loop through all worksheets until the second last one (later you use the .move after function)
        For k = 1 To N - 1

            'If the name is larger than the following worksheet, change the sequence of these two worksheets.
            'In order to enable a proper comparison, change all characters to lower case (UCase = Upper case works
            'the same way.
            If LCase(Sheets(k).Name) > LCase(Sheets(k + 1).Name) Then Sheets(k).Move After:=Sheets(k + 1)
        Next
    Next

End Sub
2
user17432547 17 Ноя 2021 в 00:55
2
Всегда помогает показать код, с которым вы работаете, и объяснить точную ошибку, которую вы получаете, когда пытаетесь его изменить. Похоже, вы сравниваете имена листов как текст, когда вам нужно отсортировать их как числа, но без вашего кода сложно сделать какие-либо предложения, как это исправить.
 – 
Tim Williams
17 Ноя 2021 в 00:58
Вы понимаете, что ваши листы сортируются правильно (первая цифра - это первое различие: 1, 2, 8) и что вы предпочитаете другой вид сортировки. Пожалуйста, поделитесь кодом, который вы использовали для получения нежелательных результатов, чтобы мы могли использовать его.
 – 
VBasic2008
17 Ноя 2021 в 01:10

2 ответа

Лучший ответ

Сортировка возрастающих листов

  • Процедура SortIncrementingSheetsTEST является примером использования (вызова) основной процедуры SortIncrementingSheets.
  • Для работы основной процедуры SortIncrementingSheets требуется процедура GetLastInteger.
  • Процедура GetLastInteger возвращает последнее целое число (последние последовательные цифры в виде числа), найденное в строке.
  • Процедура GetLastIntegerTEST является примером использования (вызова) процедуры GetLastInteger. Он печатает 13 в окне Immediate, поскольку 13 является последним целым числом в строке примера Sheet1(013).
  • По сути, все имена листов и соответствующие им последние целые числа записываются в Keys и Items dictionary, которые затем используются при сортировке листов. Раскомментируйте строки Debug.Print, чтобы лучше понять, как работает процедура, просмотрев результаты в окне "Немедленное".
  • Сортировка в процедуре основана на следующей статье Microsoft Docs от MVP Tom Urtis:
    Sort Worksheets Alphanumerically by Name
Option Explicit

Sub SortIncrementingSheetsTEST()
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    SortIncrementingSheets wb
End Sub

Sub SortIncrementingSheets( _
        ByVal wb As Workbook)
' Needs 'GetLastInteger'.
    
    If wb Is Nothing Then Exit Sub
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim sh As Object
    
    For Each sh In wb.Sheets
        dict.Add sh.Name, GetLastInteger(sh.Name)
    Next sh
    'Debug.Print Join(dict.Keys, ",")
    'Debug.Print Join(dict.Items, ",")
    
    Dim shCount As Long: shCount = wb.Sheets.Count

    Application.ScreenUpdating = False
    
    Dim i As Long
    Dim j As Long
    
    For i = 1 To shCount - 1
        For j = i + 1 To shCount
            If dict(wb.Sheets(j).Name) < dict(wb.Sheets(i).Name) Then
                wb.Sheets(j).Move Before:=wb.Sheets(i)
                'Debug.Print "Moved '" & wb.Sheets(i).Name & "' from '" _
                    & j & " to " & i & "'."
            End If
        Next j
    Next i

    Application.ScreenUpdating = True

    MsgBox "Sheets sorted.", vbInformation

End Sub

Function GetLastInteger( _
    ByVal SearchString As String) _
As Long
    
    Dim nLen As Long: nLen = Len(SearchString)
    
    Dim DigitString As String
    Dim CurrentChar As String
    Dim n As Long
    Dim FoundDigit As Boolean
    
    For n = nLen To 1 Step -1
        CurrentChar = Mid(SearchString, n, 1)
        If CurrentChar Like "#" Then ' it's a digit
            DigitString = CurrentChar & DigitString
            If Not FoundDigit Then
                FoundDigit = True
            End If
        Else ' it's not a digit
            If FoundDigit Then
                Exit For
            End If
        End If
    Next n
    
    If FoundDigit Then
        GetLastInteger = CLng(DigitString)
    Else
        GetLastInteger = -1
    End If

End Function

Sub GetLastIntegerTEST()
    Debug.Print GetLastInteger("Sheet1(013)")
End Sub
1
VBasic2008 18 Ноя 2021 в 12:17
Это отлично сработало для моих листов, спасибо! Продолжение, как мне отредактировать его, чтобы он работал иначе, чем у меня организованы вкладки? У меня есть другой рабочий лист с вкладками, обозначенными номером позиции, например, PS № 124, PS № 225, PS № 34.
 – 
user17432547
18 Ноя 2021 в 21:52
Пожалуйста. Это тот же код для вашего нового примера. Он просто смотрит на последние встречающиеся подряд цифры (в результате получается 34,124, 225). Он не «заботится» о текстовой части. Если у вас есть листы без номеров (- 1), они будут перемещены в начало книги.
 – 
VBasic2008
18 Ноя 2021 в 23:18

Это можно сделать лучше, и, не видя вашего кода, я понятия не имею, где вы ошибаетесь, но я предлагаю в виде строки, если вы так относитесь к этому, 8 больше 28.

Вы можете проверить это, перейдя в ближайшее окно редактора VBA, введя и нажав Enter ...

?str(8) > str(28)

... результат верный. Не то, что ты хочешь.

Попробуйте это, у меня получилось.

Однако есть несколько предостережений: в имени рабочего листа не может быть никаких других открывающих или закрывающих скобок, кроме тех, которые у вас есть в конце, как вы указали, например « Элемент (28) » ... это не будет нормально, « Элемент (другие скобки) (28) »

Public Sub SortSheets()
    Dim objSheet As Worksheet, objSubSheet as Worksheet
    Dim lngSortOrder As Long, lngSortSubOrder As Long
    
    For Each objSheet In ThisWorkbook.Worksheets
        lngSortOrder = Replace(Split(objSheet.Name, "(")(1), ")", "")
        
        For Each objSubSheet In ThisWorkbook.Worksheets
            lngSortSubOrder = Replace(Split(objSubSheet.Name, "(")(1), ")", "")
            
            If lngSortOrder < lngSortSubOrder Then
                objSheet.Move Before:=Sheets(objSubSheet.Index)
                Exit For
            End If
        Next
    Next
End Sub
1
Skin 17 Ноя 2021 в 02:21
Спасибо за вашу помощь - у меня это не сработало, но я знаю, что вы опубликовали это до того, как я разместил свой код. Я ценю, что вы нашли время опубликовать. :)
 – 
user17432547
18 Ноя 2021 в 21:48