Excel中的标签排序，VBA语法问题

Posted 2023-03-27

【中文标题】Excel中的标签排序，VBA语法问题

【英文标题】：Sorting tabs in Excel, VBA syntax issue

【发布时间】：2021-12-27 23:08:42

【问题描述】：

我正在尝试使用 vba 对 Excel 中的选项卡进行排序，但我对编写代码来更改我在网上找到的现有答案还不够熟悉。

我有多个 Excel 文件，每个文件都有不同的编号系统。 其中包括项目 (#ofsheet)，如项目 (1)、项目 (8)、项目 (28)。当我尝试现有代码时，它们按第 1、28 和 8 项组织起来，而应该是 1、8、28。

有人可以帮我写代码吗？谢谢。

编辑：抱歉，我最初是在手机上写的。这段代码对我来说可以将项目放入项目 (1)、项目 (11)、项目 (2)、项目 (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

【问题讨论】：

总是有助于显示您正在使用的代码，并解释您在尝试修改它时遇到的确切错误。看起来您正在将工作表名称作为文本进行比较，当您需要将它们排序为数字时，但是如果没有您的代码，就很难就如何修复它提出任何建议。

您确实意识到您的工作表被正确排序（第一个数字是第一个区别：1, 2, 8）并且您更喜欢不同类型的排序。请分享您用来获得不良结果的代码，以便我们在此基础上进行构建。

【参考方案1】：

对递增表进行排序

SortIncrementingSheetsTEST 过程是如何使用（调用）SortIncrementingSheets 主过程的示例。 主要的SortIncrementingSheets 过程需要GetLastInteger 过程才能工作。 GetLastInteger 过程返回在字符串中找到的最后一个整数（最后一个连续数字作为数字）。 GetLastIntegerTEST 过程是如何使用（调用）GetLastInteger 过程的示例。由于13 是示例字符串Sheet1(013) 中的最后一个整数，因此它会在“立即”窗口中打印13。 基本上，所有工作表名称及其对应的最后一个整数都写入dictionary 的Keys 和Items，然后在对工作表进行排序时使用。通过查看即时窗口中的结果，取消注释 Debug.Print 行以更好地了解该过程的工作原理。 过程中的排序基于MVP Tom Urtis 的以下 Microsoft Docs 文章：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

【讨论】：

这对我的床单很有用，谢谢！跟进，我将如何编辑它以适应我组织标签的其他方式？我有一个不同的工作表，其中带有标签为 Item# number 的标签，例如它们是 PS# 124、PS# 225、PS# 34。

不客气。它与您的新示例的代码相同。它只查看最后出现的连续数字（结果为 34. 124, 225）。它不“关心自己”与文本部分。如果您的工作表没有数字 (- 1)，它们将被移动到工作簿的开头。

【参考方案2】：

这也许可以做得更好，而且不用看你的代码，我不知道你哪里出错了，但我建议作为一个字符串，如果你这样处理，8大于28。

您可以通过进入 VBA 编辑器中的即时窗口并输入并按回车键来测试它...

?str(8) > str(28)

...结果为真。不是你想要的。

试试这个，它对我有用。

但有几点需要注意，除了您在末尾指定的那些之外，工作表名称中不能有其他左方或右方括号，例如"Item (28)" ...这样不行，"Item（其他括号）(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

【讨论】：

感谢您的帮助 - 这对我不起作用，但我知道您在我发布代码之前发布了它。感谢您抽出宝贵时间发帖。 :)