我正在嘗試使用 vba 對 Excel 中的選項卡進行排序,但我不太熟悉撰寫代碼來更改我在網上找到的現有答案。
我有多個 Excel 檔案,每個檔案都有不同的編號系統。那些包括專案 (#ofsheet),所以像專案 (1)、專案 (8)、專案 (28)。當我嘗試現有代碼時,它們會按照 Item 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
uj5u.com熱心網友回復:
這可能可以做得更好,而且沒有看到你的代碼,我不知道你哪里出錯了,但我建議作為一個字串,如果你這樣對待它,8 大于 28。
您可以通過進入 VBA 編輯器中的即時視窗并輸入并按回車鍵來測驗這一點。
?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
uj5u.com熱心網友回復:
排序遞增表
- 該
SortIncrementingSheetsTEST程序是如何使用(呼叫)主SortIncrementingSheets程序的示例。 - 主程式
SortIncrementingSheets需要GetLastInteger程式才能作業。 - 該
GetLastInteger程序回傳在字串中找到的最后一個整數(最后一個連續數字作為數字)。 - 該
GetLastIntegerTEST程序是如何使用(呼叫)該GetLastInteger程序的示例。它列印13在立即視窗中,因為它13是示例字串中的最后一個整數Sheet1(013)。 - 基本上,所有作業表名稱及其相應的最后一個整數都寫入a的
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
轉載請註明出處,本文鏈接:https://www.uj5u.com/qukuanlian/359774.html
