排序

半百

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub 工作表名排序()  '//2024.4.7
   
2.     With ThisWorkbook
   
3.         For i = 2 To .Sheets.Count - 1
   
4.             For j = i + 1 To .Sheets.Count
   
5.                 If .Sheets(j).Name < .Sheets(i).Name Then
   
6.                     .Sheets(j).Move before:=.Sheets(i)
   
7.                 End If
   
8.             Next j
   
9.         Next i
   
10.     End With
    
11.     MsgBox "OK！"
    
12. End Sub
    
13. 
    

复制代码

ddz79101

半百 发表于 2024-4-7 15:16

谢谢老师！未成功

ddz79101

ykcbf1100 发表于 2024-4-7 15:26
参与一下。。。

谢谢老师！未成功

ykcbf1100

ddz79101 发表于 2024-4-7 16:47
谢谢老师！未成功

未成功？不可能吧，我这里可以的。

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar(), i&, r&, wks As Worksheet
   
    For i = 2 To Worksheets.Count
        r = r + 1
        ReDim Preserve ar(1 To r)
        ar(r) = Worksheets(i).Name
    Next i
   
    bSort1 ar, 1, UBound(ar), False
    For i = 1 To UBound(ar)
        Worksheets(ar(i)).Move after:=Worksheets(1)
    Next i
    Beep
End Sub

Function bSort1(ar, iFirst&, iLast&, Optional isOrder As Boolean = True)
    Dim i&, j&, vTemp
    For i = iFirst To iLast - 1
        For j = iFirst To iLast + iFirst - 1 - i
            If ar(j) <> ar(j + 1) Then
                If ar(j) < ar(j + 1) Xor isOrder Then
                    vTemp = ar(j): ar(j) = ar(j + 1): ar(j + 1) = vTemp
                End If
            End If
        Next j
    Next i
End Function

gwjkkkkk

参与一下。。。

yjh_27

参见附件。

ddz79101

gwjkkkkk 发表于 2024-4-7 19:03
参与一下。。。

谢谢老师！