Excel、VBA 语法问题中的排序选项卡
Sorting tabs in Excel, VBA syntax issue
我正在尝试使用 vba 对 Excel 中的选项卡进行排序,但我不太熟悉如何编写代码来更改我在网上找到的现有答案。
我有多个 Excel 文件,每个文件都有不同的编号系统。
这些包括项目 (#ofsheet),因此如项目 (1)、项目 (8)、项目 (28)。当我尝试现有代码时,它们按项目 1、28 和 8 组织自己,当时它应该是 1、8、28。
有人能帮我写代码吗?谢谢。
编辑:抱歉,我最初是在 phone 上写的。这段代码对我有用,可以将商品放入商品 (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
这也许可以做得更好,而且没有看到你的代码,我不知道你哪里错了,但我建议作为一个字符串,如果你这样处理,8 大于 28 .
您可以通过直接进入 VBA 编辑器中的 window 并输入并按回车键来测试它 ...
?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
对递增工作表进行排序
SortIncrementingSheetsTEST
过程是如何使用(调用)主要 SortIncrementingSheets
过程的示例。
- 主要
SortIncrementingSheets
程序需要 GetLastInteger
程序才能工作。
GetLastInteger
过程 returns 在字符串中找到的最后一个整数(作为数字的最后一个连续数字)。
GetLastIntegerTEST
过程是如何使用(调用)GetLastInteger
过程的示例。它在立即 window 中打印 13
因为 13
是示例字符串 Sheet1(013)
. 中的最后一个整数
- 基本上,所有的sheet名字和它们对应的最后一个整数都被写入
dictionary
的Keys
和Items
,然后在排序时使用。 sheet秒。取消注释 Debug.Print
行以通过查看立即 window. 中的结果更好地了解该过程的工作原理
- 过程中的排序基于
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
我正在尝试使用 vba 对 Excel 中的选项卡进行排序,但我不太熟悉如何编写代码来更改我在网上找到的现有答案。
我有多个 Excel 文件,每个文件都有不同的编号系统。 这些包括项目 (#ofsheet),因此如项目 (1)、项目 (8)、项目 (28)。当我尝试现有代码时,它们按项目 1、28 和 8 组织自己,当时它应该是 1、8、28。
有人能帮我写代码吗?谢谢。
编辑:抱歉,我最初是在 phone 上写的。这段代码对我有用,可以将商品放入商品 (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
这也许可以做得更好,而且没有看到你的代码,我不知道你哪里错了,但我建议作为一个字符串,如果你这样处理,8 大于 28 .
您可以通过直接进入 VBA 编辑器中的 window 并输入并按回车键来测试它 ...
?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
对递增工作表进行排序
SortIncrementingSheetsTEST
过程是如何使用(调用)主要SortIncrementingSheets
过程的示例。- 主要
SortIncrementingSheets
程序需要GetLastInteger
程序才能工作。 GetLastInteger
过程 returns 在字符串中找到的最后一个整数(作为数字的最后一个连续数字)。GetLastIntegerTEST
过程是如何使用(调用)GetLastInteger
过程的示例。它在立即 window 中打印13
因为13
是示例字符串Sheet1(013)
. 中的最后一个整数
- 基本上,所有的sheet名字和它们对应的最后一个整数都被写入
dictionary
的Keys
和Items
,然后在排序时使用。 sheet秒。取消注释Debug.Print
行以通过查看立即 window. 中的结果更好地了解该过程的工作原理
- 过程中的排序基于
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