Excel VBA:按字母数字顺序对图纸进行排序

Question

我有一本大约30张的工作簿，我正试图将其按字母数字顺序排列。例如："；纽约9号、纽约10号、纽约11号"；

我的代码无法在一位数之后排序两位数"10、11、9〃；

有人熟悉这方面的核算方法吗？非常感谢！

Sub AscendingSortOfWorksheets()
'Sort worksheets in a workbook in ascending order
Dim SCount, i, j As Integer

Application.ScreenUpdating = False

SCount = Worksheets.Count
For i = 1 To SCount - 1
For j = i + 1 To SCount

If Worksheets(j).Name < Worksheets(i).Name Then
Worksheets(j).Move before:=Worksheets(i)
End If

Next j
Next i

End Sub

Answer 1

如注释中所述，您需要用零填充数字，在您的情况下，个位数需要用1零填充。使用此功能

Function PadNumber(sName As String, lNumOfDigits As Long) As String
Dim v As Variant
Dim vPrefixList As Variant
Dim sTemp As String
Dim i As Long

' Add all other possible prefixes in this array
vPrefixList = Array("New York")

sTemp = sName

For Each v In vPrefixList
sTemp = Replace(LCase(sTemp), LCase(v), "")
Next v

sTemp = Trim(sTemp)
PadNumber = sTemp

For i = Len(sTemp) + 1 To lNumOfDigits
PadNumber = "0" & PadNumber
Next i

PadNumber = Replace(sName, sTemp, PadNumber)

End Function

然后将线路If Worksheets(j).Name < Worksheets(i).Name Then改为

If PadNumber(LCase(Worksheets(j).Name), 2) < PadNumber(LCase(Worksheets(i).Name), 2) Then

注意我在比较中添加了LCase。在这种特殊情况下，区分大小写可能对你来说并不重要，但这是你需要时刻记住的。

Answer 2

以下是实现的一种方法

逻辑：

1. 创建一个二维数组，以存储空格和图纸名称后的数字
2. 对数组进行排序
3. 排列工作表

代码：

Sub Sample()
Dim SheetsArray() As String
'~~> Get sheet counts
Dim sheetsCount As Long: sheetsCount = ThisWorkbook.Sheets.Count

'~~> Prepare our array for input
'~~> One part will store the number and the other will store the name
ReDim SheetsArray(1 To sheetsCount, 1 To 2)

Dim ws As Worksheet
Dim tmpAr As Variant
Dim sheetNo As Long
Dim i As Long: i = 1
Dim j As Long

'~~> Loop though the worksheest
For Each ws In ThisWorkbook.Sheets
tmpAr = Split(ws.Name)

'~~> Extract last number after space
sheetNo = Trim(tmpAr(UBound(tmpAr)))

'~~> Store number and sheet name as planned
SheetsArray(i, 1) = sheetNo
SheetsArray(i, 2) = ws.Name
i = i + 1
Next ws

'~~> Sort the array on numbers
Dim TempA, TempB
For i = LBound(SheetsArray) To UBound(SheetsArray) - 1
For j = i + 1 To UBound(SheetsArray)
If SheetsArray(i, 1) > SheetsArray(j, 1) Then
TempA = SheetsArray(j, 1): TempB = SheetsArray(j, 2)
SheetsArray(j, 1) = SheetsArray(i, 1): SheetsArray(j, 2) = SheetsArray(i, 2)
SheetsArray(i, 1) = TempA: SheetsArray(i, 2) = TempB
End If
Next j
Next i

'~~> Arrange the sheets
For i = UBound(SheetsArray) To LBound(SheetsArray) Step -1
ThisWorkbook.Sheets(SheetsArray(i, 2)).Move After:=ThisWorkbook.Sheets(sheetsCount)
sheetsCount = sheetsCount - 1
Next i
End Sub

假设：

1. 工作表名称中有空格
2. 图纸名称的格式为New York #