递归算法
 '1 什么是递归？
 '递归就是自已调用自已。
 '2,用递归有什么好处？
 '简化代码，让程序更简捷。特别是在循环层数不定的情况下可以大大简单代码。
 '3,递归有什么坏处？
 '因为递归在使用时会产生大量储存临时信息的“栈”（按先进后出储存信息），所以运行效果比较低，所以一般不建议使用递归设计程序
 '2 例: 计算4的阶乘 (4 * 3 * 2 * 1 = 24)
 
Sub 一般方法()
     Dim k, x
     k = 1
     For x = 4 To 1 Step -1
        k = k * x
     Next x
     MsgBox k
End Sub
 
 
   Sub 递归1()
      MsgBox s(5)
   End Sub
   -----------------------------------
'函数法
   Function s(n As Integer) As Integer
     If n = 1 Then
        s = 1
     Else
       s = n * s(n - 1)
     End If
   End Function
 
 
  Sub 递归2()
    k = 1
    s2 4
    MsgBox k
  End Sub
'sub过程法
   Sub s2(n As Integer)
    ' Dim m
     If n > 0 Then
      k = k * n
     'm = n
      s2 n - 1
     End If
   End Sub
 
 
'3 例：计算1+2+3+.5
 Sub 递归3()
   k = 0
   add5 1
   'MsgBox k
 End Sub
 
 
  Sub add5(n As Integer)
   If n < 5 Then
     k = k + n
     add5 n + 1
   End If
  End Sub
 
Sub 冒泡排序()
 
Dim arr, temp, x, y, t, k
     t = Timer
     arr = Range("a1:a10")
     
     For x = 1 To UBound(arr) - 1
       For y = x + 1 To UBound(arr) '只和当前数字下面的数进行比较
         If arr(x, 1) > arr(y, 1) Then '如果它大于它下面某一个数字
           temp = arr(x, 1)
           arr(x, 1) = arr(y, 1)
           arr(y, 1) = temp
         End If
       Next y
     Next x
     
     Range("b3").Resize(x) = ""
     Range("b3").Resize(x) = arr
     'Range("b2") = Timer - t
     MsgBox k
End Sub

 -----------------------------------------------------------------
Sub 冒泡排序演示()
    Dim arr, temp, x, y, t, k
     For x = 1 To 9
                             Range("a" & x).Interior.ColorIndex = 3
       For y = x + 1 To 10  '只和当前数字下面的数进行比较
                             Range("a" & y).Interior.ColorIndex = 4
         If Cells(x, 1) > Cells(y, 1) Then '如果它大于它下面某一个数字
           temp = Cells(x, 1)
           Cells(x, 1) = Cells(y, 1)
           Cells(y, 1) = temp
    2     End If
                             Range("a" & y).Interior.ColorIndex = xlNone
       Next y
                             Range("a" & x).Interior.ColorIndex = xlNone
                             
     Next x

End Sub
 
选择排序
 
Sub 选择排序()
  Dim arr, temp, x, y, t, iMax, k, k1, k2
  t = Timer
  arr = Range("a1:a10")
  
  For x = UBound(arr) To 1 + 1 Step -1
     iMax = 1 '最大的索引
     For y = 1 To x
          If arr(y, 1) > arr(iMax, 1) Then iMax = y
     Next y
     temp = arr(iMax, 1)
     arr(iMax, 1) = arr(x, 1)
     arr(x, 1) = temp
  Next x
  
  'Range("c3").Resize(UBound(arr)) = ""
  'Range("c3").Resize(UBound(arr)) = arr
  'Range("c2") = Timer - t
  'MsgBox k1
End Sub
--------------------------------------------------------------------
Sub 选择排序单元格演示()
  Dim arr, temp, x, y, t, iMax, k, k1, k2

  For x = 10 To 2 Step -1
     iMax = 1
                       Range("a" & x).Interior.ColorIndex = 3
     For y = 1 To x
                       Range("a" & y).Interior.ColorIndex = 4
          If Cells(y, 1) > Cells(iMax, 1) Then
                       Range("a" & iMax).Interior.ColorIndex = xlNone
           iMax = y
          End If
                       Range("a" & y).Interior.ColorIndex = xlNone
                       Range("a" & iMax).Interior.ColorIndex = 6
                       
     Next y
     temp = Cells(iMax, 1)
     Cells(iMax, 1) = Cells(x, 1)
     Cells(x, 1) = temp
     Range("a" & x).Interior.ColorIndex = xlNone
     Range("a" & iMax).Interior.ColorIndex = xlNone
  Next x

End Sub
 
插入排序
 
Sub 插入排序()
Dim arr, temp, x, y, t, iMax, k, k1, k2
  t = Timer
  arr = Range("a1:a10")
  For x = 1 + 1 To UBound(arr)
  
     temp = arr(x, 1) '记得要插入的值
     
     For y = x - 1 To 1 Step -1
       If arr(y, 1) <= temp Then Exit For
       arr(y + 1, 1) = arr(y, 1)
       'k1 = k1 + 1
     Next y
     arr(y + 1, 1) = temp
     'k2 = k2 + 1
  Next
 ' Range("d3").Resize(UBound(arr)) = ""
 ' Range("d3").Resize(UBound(arr)) = arr
 'Range("d2") = Timer - t
 MsgBox k1
End Sub
-----------------------------------------------------------
Sub 插入排序单元格演示()
On Error Resume Next
  Dim arr, temp, x, y, t, iMax, k
  For x = 2 To 10
  
     temp = Cells(x, 1) '记得要插入的值
               Range("A" & x).Interior.ColorIndex = 3
     For y = x - 1 To 1 Step -1
               Range("A" & y).Interior.ColorIndex = 4
       If Cells(y, 1) <= temp Then Exit For
               Cells(y + 1, 1) = Cells(y, 1)
               Range("A" & y).Interior.ColorIndex = xlNone
     Next y
     Cells(y + 1, 1) = temp
               Range("A" & y).Interior.ColorIndex = xlNone
               Range("A" & x).Interior.ColorIndex = xlNone
  Next

End Sub
 
希尔排序
 
Sub 希尔排序()
  Dim arr
  Dim 总大小, 间隔, x, y, temp, t
  t = Timer
  arr = Range("a1:a30")
  总大小 = UBound(arr) - LBound(arr) + 1
  间隔 = 1
  
  If 总大小 > 13 Then
     Do While 间隔 < 总大小
       间隔 = 间隔 * 3 + 1
     Loop
     间隔 = 间隔 \ 9
  End If
  
'  Stop

  Do While 间隔
     For x = LBound(arr) + 间隔 To UBound(arr)
      temp = arr(x, 1)
      For y = x - 间隔 To LBound(arr) Step -间隔
         If arr(y, 1) <= temp Then Exit For
         arr(y + 间隔, 1) = arr(y, 1)
        ' k1 = k1 + 1
      Next y
      arr(y + 间隔, 1) = temp
     Next x
    间隔 = 间隔 \ 3
   Loop
   
  ' MsgBox k1
   'Range("e3").Resize(5000) = ""
    Range("d1").Resize(UBound(arr)) = arr
   'Range("e2") = Timer - t
End Sub

Sub 打乱顺序()
 Dim arr, temp, x
 arr = Range("a1:a" & Range("a65536").End(xlUp).Row)
 
 For x = 1 To UBound(arr)
   num = Int(Rnd() * UBound(arr) + 1)
   temp = arr(num, 1)
   arr(num, 1) = arr(x, 1)
   arr(x, 1) = temp
 Next x
 
 Range("a1").Resize(x - 1) = arr
End Sub
------------------------------------------------------------
Sub 希尔排序单元格演示()
  Dim arr
  Dim 总大小, 间隔, x, y, temp, t
  t = Timer
  arr = Range("a1:a" & Range("a65536").End(xlUp).Row)
  总大小 = UBound(arr) - LBound(arr) + 1
  间隔 = 1
  
  If 总大小 > 13 Then
     Do While 间隔 < 总大小
       间隔 = 间隔 * 3 + 1
     Loop
     间隔 = 间隔 \ 9
  End If
  
'  Stop

  Do While 间隔
  
     For x = LBound(arr) + 间隔 To UBound(arr)
      temp = Cells(x, 1)
      Range("a" & x).Interior.ColorIndex = 3
      
      For y = x - 间隔 To LBound(arr) Step -间隔
          Range("a" & y).Interior.ColorIndex = 6
         If Cells(y, 1) <= temp Then Exit For
         Cells(y + 间隔, 1) = Cells(y, 1)
        ' k1 = k1 + 1
      Next y
      
      Cells(y + 间隔, 1) = temp
      Range("a1:a30").Interior.ColorIndex = xlNone
     Next x
    间隔 = 间隔 \ 3
   Loop
   
  ' MsgBox k1
   'Range("e3").Resize(5000) = ""
   ' Range("d1").Resize(UBound(arr)) = arr
   'Range("e2") = Timer - t
End Sub
 
快速排序
 
Sub dd()
    Dim arr1(0 To 4999) As Long, arr, x, t
    t = Timer
    arr = Range("a1:a5000")
    For x = 1 To 5000
      arr1(x - 1) = arr(x, 1)
    Next x
    QuickSort arr1()
    Range("f2") = Timer - t
End Sub
Public Sub QuickSort(ByRef lngArray() As Long)

    Dim iLBound As Long

    Dim iUBound As Long

    Dim iTemp As Long

    Dim iOuter As Long

    Dim iMax As Long
   

    iLBound = LBound(lngArray)

    iUBound = UBound(lngArray)

    

    '若只有一个值，不排序

    If (iUBound - iLBound) Then

        For iOuter = iLBound To iUBound

            If lngArray(iOuter) > lngArray(iMax) Then iMax = iOuter

        Next iOuter

        

        iTemp = lngArray(iMax)

        lngArray(iMax) = lngArray(iUBound)

        lngArray(iUBound) = iTemp

    

        '开始快速排序

        InnerQuickSort lngArray, iLBound, iUBound

    End If
    Range("f3").Resize(5000) = Application.Transpose(lngArray)

End Sub

 

Private Sub InnerQuickSort(ByRef lngArray() As Long, ByVal iLeftEnd As Long, ByVal iRightEnd As Long)

    Dim iLeftCur As Long

    Dim iRightCur As Long

    Dim iPivot As Long

    Dim iTemp As Long

    

    If iLeftEnd >= iRightEnd Then Exit Sub

    

    iLeftCur = iLeftEnd

    iRightCur = iRightEnd + 1

    iPivot = lngArray(iLeftEnd)

    

    Do

        Do

            iLeftCur = iLeftCur + 1

        Loop While lngArray(iLeftCur) < iPivot

        

        Do

            iRightCur = iRightCur - 1

        Loop While lngArray(iRightCur) > iPivot

        

        If iLeftCur >= iRightCur Then Exit Do

        

        '交换值

        iTemp = lngArray(iLeftCur)

        lngArray(iLeftCur) = lngArray(iRightCur)

        lngArray(iRightCur) = iTemp

    Loop

    

    '递归快速排序

    lngArray(iLeftEnd) = lngArray(iRightCur)

    lngArray(iRightCur) = iPivot

    

    InnerQuickSort lngArray, iLeftEnd, iRightCur - 1

    InnerQuickSort lngArray, iRightCur + 1, iRightEnd

End Sub

数字排序的方法有很多，最简单的方式可能就是下面两种方法了。
 =SMALL($G$29:$G37,1*ROW(A1)-1+COLUMN(A1))
 =SMALL($G$29:G37,ROW(A1:A9))

获取当前sheet列表
 
Sub GetSheetList()
    Dim sht     As Object       '// sheet
    Dim s       As String       '// 追加sheet名
    Dim i       As Long         '// loop count
    
    '// 追加sheet
    Call Sheets.Add(After:=Sheets(Sheets.Count))
    s = "AddSheet"
    ActiveSheet.Name = s
    ActiveSheet.Activate
    ActiveSheet.Range("A1").Select
    
    '// loop worksheet
    For Each sht In Sheets
        '// 不是追加sheet的场合
        If (sht.Name <> "AddSheet") Then
            '// 把sheet名拷贝到追加sheet
            ActiveCell.Offset(i, 0).Value = sht.Name
        End If
        
        i = i + 1
    Next
End Sub
 
 
手动修改顺序
 
 
按照修改后的顺序进行排序
 
Sub ChangeOrder()
    Dim ar()    As String       '// sheet名数组
    Dim i       As Integer      '// loop count
    Dim s       As String       '// cell值
    
    Sheets("AddSheet").Select
    Sheets("AddSheet").Activate
    Range("A1").Select
    
    i = 0
    ReDim ar(i)
    
    '// loop A列
    Do
        '// cell值取得
        s = ActiveCell.Offset(i, 0).Value
        
        '// cell值为空的场合
        If (s = "") Then
            '// 跳出loop
            Exit Do
        End If
        
        '// 把sheet名放到数组中
        ReDim Preserve ar(i)
        ar(i) = s
        
        i = i + 1
    Loop
    
    '// 按照AddSheet的顺序排列
    i = 0
    Do
        '// 数组要素为空
        If (i > UBound(ar)) Then
            '// 跳出loop
            Exit Do
        End If
        
        '// 将数组当前循环值的表名移动到当前循环计数器值的右侧
        Sheets(ar(i)).Move before:=Sheets(i + 1)
        
        i = i + 1
    Loop
    
    '// 删除的确认对话框不表示
    Application.DisplayAlerts = False
    
    '// "AddSheet"sheet删除
    Sheets("AddSheet").Delete
    
    Application.DisplayAlerts = True
End Sub

/**
 * 二维数组根据某个字段排序
 * @param $data 多维数组
 * @param $index 需要排序的字段
 * @param string $order 排序方式 默认 asc:顺序，desc:倒序
 * @return mixed 排序后的二维数组
 */
function array_order($data, $index, $order = 'asc')
{
    $index_array = array_column($data, $index);
    $order = strtoupper($order);
    array_multisort($index_array, $order == 'ASC' ? SORT_ASC : SORT_DESC, $data);
    return $data;
}