堆排序(使用VBA实现）
大根堆，即父节点大于等于其子节点，但左、右子节点大小不考虑。

堆排序的主体思路为：从最后一个父节点开始，调整将该节点调整为大根堆，然后调整上一个父节点为大根堆，最终将首个父节点为大根堆。所以最大的值即为首个父节点。
首个父节点与最后一个节点相调换，最值被放到最后一个节点，循环，最终完成排序。

在进行排序之前，首先需要确定的是最后一个父节点、每父节点对应的左子节点和右子节点的下标。

假设一个数组arr()，其上边界为L，下边界为H，父节点对应的下标为dad，两个子节点下标分别为left_son和right_son，最后一个父节点的下标为last_dad，则有如下关系：

L=lbound(arr)

H=ubound(arr)

left_son=2dad+1-L

right_son=left_son+1=2dad+2-L

last_dad=(L+H-1)/2
代码如下：

Sub AdjustMaxHeap(ByRef arr() As Long, indx_start As Long, arrLen As Long)
//函数的主要功能为从index_start节点为起点，调整为大根堆
    Dim dad As Long
    Dim son As Long
    Dim left_son As Long
    Dim righ_son As Long
    Dim L As Long: L = LBound(arr)
        
    dad = indx_start    //last dad
    left_son = 2 * dad + 1 - L
    right_son = left_son + 1
    son = left_son
   
    Do While (son <= arrLen)
    
        right_son = left_son + 1
        If right_son <= arrLen Then
            If arr(left_son) < arr(right_son) Then  //可以使用具体函数进行比较
                son = right_son
            End If
         End If
             
        If son <= arrLen Then
            If arr(dad) < arr(son) Then
            
                Dim t As Long  //swap start
                t = arr(dad)
                arr(dad) = arr(son)
                arr(son) = t  //swap end
                
                dad = son     //vital
                left_son = 2 * dad + 1 - L
                son = left_son
            Else
                GoTo exitLoop
            End If
        End If
    Loop
exitLoop:
 
End Sub

Sub heapSort(ByRef arr() As Long)
    Dim i As Long
    Dim L As Long
    Dim H As Long
    L = LBound(arr)
    H = UBound(arr)
    Dim last_dad As Long: last_dad = (L + H - 1) / 2
    
    //首次，将整个树调整为大根堆
    For i = last_dad To L Step -1
        AdjustMaxHeap arr, i, H
    Next i
    
    Dim t As Long
    t = arr(H)
    arr(H) = arr(L)
    arr(L) = t
    
    For i = H - 1 To L Step -1
        //因为只是将首节点和根节点调换，其他父节点不受影响，所以只需从首节点处
        //将整个树调整为大根堆
        AdjustMaxHeap arr, L, i
        //swap(首节点,尾节点)
        t = arr(L)
        arr(L) = arr(i)
        arr(i) = t
    Next i
    
End Sub

Sub main()
    Dim arr() As Long
    ReDim arr(1 To 60000) As Long
    For i = 1 To 60000
        arr(i) = 60001 - i
    Next i
    
    heapSort arr
    For i = 1 To 60000
        Sheets(1).Cells(i, 2) = arr(i)
    Next i
    
    
End Sub

学习资源：《Excel VBA从入门到进阶》第22集 by兰色幻想
这集视频学习的是数组的空间。
1、数组的大小
数组是用编号排序的，那么如何获得一个数组的大小呢？
——表示数组大小的函数：
Lbound(数组) 可以获取数组的最小下标(编号)
Ubound(数组) 可以获取数组的最大上标(编号)
Ubound(数组,1) 可以获得数组的行方面(第1维)最大上标
Ubound(数组,2) 可以获得数组的列方向(第2维)的最大上标
2、动态数组的动态扩充
     如果一个数组无法或不方便计算出总的大小，而在一些特殊情况下又不允许有空位。这时我们就需要用动态的导入方法。
    ReDim Preserve arr() 可以声明一个动态大小的数组，而且可以保留原来的数值，就相当于厂房小了，可以改扩建增大，但是它只能让最未维实现动态。如果是一维不存在最未维，只有一维；如果是二维数组的话就只能重新声明第二维。
      注意和ReDim arr()区分，如果在这里误用了ReDim arr()，会清空原数组内容。
例1：获取大于30数字的数据作为下拉菜单的数据源。
Private Sub ComboBox1_GotFocus()
'使用工作簿事件，数据源发生了变化，下拉菜单也会自动跟着变化，不用手动运行程序更新。

Dim arr(), x, arr1, k
arr1 = Range("a1:a10")

For x = 1 To UBound(arr1)
    '如果arr1的数据大于30，k+1，重新声明数组arr大小，并把该数字放入arr
    If arr1(x, 1) > 30 Then
        k = k + 1
        ReDim Preserve arr(1 To k)
        arr(k) = arr1(x, 1)
    End If
Next x
ComboBox1.List = arr
End Sub
例2：读取下表中产品B的数据放入B10单元格。
Sub d7()

Dim arr, arr1()
Dim x, k

arr = Range("B2:E7")

For x = 1 To UBound(arr)
    If arr(x, 1) = "B" Then
        k = k + 1
        '二维数组只能声明最后一维的大小，即列数
        '我们能确定的是数据有4列，不知道有几行
        '但行数不能改变，只能改变列，所以就把数据反过来放入数组
        ReDim Preserve arr1(1 To 4, 1 To k)
        arr1(1, k) = arr(x, 1)
        arr1(2, k) = arr(x, 2)
        arr1(3, k) = arr(x, 3)
        arr1(4, k) = arr(x, 4)
    End If
Next x

'因为读入数组的是4行2列，但实际数据是2行4列，需要把数组转置一下再放入单元格。
Range("B10").Resize(k, 4) = Application.Transpose(arr1)

End Sub
结果展示：
如果觉得二维数组逐次声明大小很麻烦，可以先把数组定义得足够大：
Sub d8()

Dim x, k
Dim arr, arr1(1 To 100000, 1 To 4)
arr = Range("a1:d6")

For x = 1 To UBound(arr)
    If arr(x, 1) = "B" Then
        k = k + 1
        arr1(k, 1) = arr(x, 1)
        arr1(k, 2) = arr(x, 2)
        arr1(k, 3) = arr(x, 3)
        arr1(k, 4) = arr(x, 4)
    End If
Next x
     
'只把扩充的K行4列填充到指定地点，不管数组大小。
Range("a15").Resize(k, 4) = arr1

End Sub
3、清空数组
   使用earse语句。
例：A列数据转化为D:F列样式。
思路分析：
把A列连续数据依次放入数组arr1。
arr读入arr1不为空的数据，遇到数据为空，停止读入arr1；把arr依次写入D列单元格，写入完毕后清空arr内容，并跳到下一列。
继续写入arr1不为空数据，放入E列。
按此逻辑重复循环以上三步，直到把arr1读写完毕。
Sub d9()
Dim arr, arr1(1 To 1000, 1 To 1)
Dim x, m, k
arr = Range("a1:a16")

For x = 1 To UBound(arr)
    If arr(x, 1) <> "" Then
        k = k + 1
        arr1(k, 1) = arr(x, 1)
    Else
        m = m + 1
        Range("c1").Offset(0, m).Resize(k) = arr1
        Erase arr1
        k = 0
    End If
Next x
End Sub

在excel工作簿中对有多个工作表，由于个人需要，对每个工作表中某一值的比较大小后，然后进行排序。

由于vba中字典对应值比较难以排序，所以就分为两步

第一步是提取工作表名和对应字段写到工作表中：

Sub getname()
    Dim sheet As Worksheet
    Dim k As Integer
    k = 17
    For Each sheet In Worksheets
        Cells(k, 1) = sheet.Name
        Cells(k, 2) = sheet.Cells(2, 3)
        k = k + 1
    Next
End Sub

得到后排序：



再利用第二个函数对排序后的工作表名进行相应的移动：

Sub sortmysheet()
    Dim sheet As Worksheet
    Dim sheetname As String
    Dim i As Integer
    Set sheet = ActiveSheet
    For i = 1 To 41
        sheetname = sheet.Cells(i, 1)
        Sheets(sheetname).Move after:=Sheets(i)
    Next
    sheet.Activate
End Sub

其中 sheet是新建了一个空白工作表，然后一个41行

 

VBA学习笔记2-数据结构类型ArrayList
一、这个东西是干什么的
二、创建ArrayList
1，前期绑定
2，后期绑定
三、常用方法和属性
1，添加
2，判断集合大小
3，重点来了排序的办法
3.1，升序排序
3.2，降序排序
4，复制集合的方法
5，删除办法
6，可以直接复制成一个数组

一、这个东西是干什么的

在VBA里数组的排序是很让人头痛的事情，一般采用冒泡，选择，快速，插入，希尔等算法来对数组进行排序


冒泡，选择，插入排序等因为循环次数太多，效率感人
快速排序，因为条件苛刻，要求整数，并且最大和最小相差太大，速度也会很慢
希尔排序，算法真心它能看明白我，我看不明白它


有没有一种又简单，又好用的对数组进行排序的

答案是有，知道的就有2个现成的对象，可以调用，今天我们来学习其中一个ArrayList对象

二、创建ArrayList
1，前期绑定


单击“工具——引用”，在“引用”对话框中，找到并选中mscorlib.dll前的复选框
Dim arrlist As New arraylist

2，后期绑定
Sub lizi2()
    Dim arrList As Object
    Set arrList = CreateObject("System.Collections.ArrayList")
    
    Set arrList = Nothing
End Sub

三、常用方法和属性
1，添加

Add方法，arrList.Add item

itme 可以是数字，字符串，对象等变量，但是如果排序数据类型尽量统一，经过测试数字和文本比较会出错，用这方法的时候，都用数字好了

Sub lizi2()
    Dim arrList As Object
    Set arrList = CreateObject("System.Collections.ArrayList")
    arrList.Add 1
    arrList.Add 11
    arrList.Add 5
    arrList.Add 6
    arrList.Add 9
    Set arrList = Nothing
End Sub


Insert方法在特定位置插入数据

Sub lizi2()
    Dim arrList As Object, i As Long
    Set arrList = CreateObject("System.Collections.ArrayList")
    arrList.Add 1
    arrList.Add 11
    arrList.Add 5
    arrList.Add 6
    arrList.Add 9
    arrList.Insert 0, 10
    For i = 0 To arrList.count - 1
        Debug.Print i & ":" & arrList(i)
    Next
    Set arrList = Nothing
End Sub

显示结果
0:10
1:1
2:11
3:5
4:6
5:9

2，判断集合大小

ArrayList.Count，来判断，是从0开始到ArrayList.Count-1的，循环的时候注意

For i = 0 To arrList.count - 1
    Debug.Print i & ":" & arrList(i)
Next

3，重点来了排序的办法
3.1，升序排序
ArrayList.sort
3.2，降序排序
ArrayList.sort

ArrayList.Reverse

先排序，后面接一句这个就可以降序排序
Sub lizi2()
    Dim arrList As Object, i As Long
    Set arrList = CreateObject("System.Collections.ArrayList")
    arrList.Add 1
    arrList.Add 11
    arrList.Add 5
    arrList.Add 6
    arrList.Add 9
    arrList.Insert 0, 10
    arrList.Sort
    For i = 0 To arrList.count - 1
        Debug.Print i & ":" & arrList(i)
    Next
    Set arrList = Nothing
End Sub

显示结果
0:1
1:5
2:6
3:9
4:10
5:11

降序
Sub lizi2()
    Dim arrList As Object, i As Long
    Set arrList = CreateObject("System.Collections.ArrayList")
    arrList.Add 1
    arrList.Add 11
    arrList.Add 5
    arrList.Add 6
    arrList.Add 9
    arrList.Insert 0, 10
    arrList.Sort  '先排序，这时候是升序
    arrList.Reverse  '再来一句相反的，变降序了
    For i = 0 To arrList.count - 1
        Debug.Print i & ":" & arrList(i)
    Next
    Set arrList = Nothing
End Sub

显示结果
0:11
1:10
2:9
3:6
4:5
5:1

速度又快，有简单
4，复制集合的方法

Clone方法

Sub lizi2()
    Dim arrList As Object, i As Long
    Dim arrList2 As Object, brr()
    Set arrList = CreateObject("System.Collections.ArrayList")
    Set arrList2 = CreateObject("System.Collections.ArrayList")
    arrList.Add 1: arrList.Add 11: arrList.Add 9
    arrList.Add 5: arrList.Add 6: arrList.Insert 0, 10
    Set arrList2 = arrList.Clone  '把没排序之前的集合复制一个新的
    arrList.Sort
    arrList.Reverse
    ReDim brr(1 To arrList.count + 1, 1 To 1)
    For i = 0 To arrList.count - 1
        brr(i + 1, 1) = arrList(i)
    Next
    Range("a1").Resize(arrList.count + 1, 1).Value = brr
    ReDim brr(1 To arrList.count + 1, 1 To 1)
    For i = 0 To arrList2.count - 1
        brr(i + 1, 1) = arrList2(i)
    Next
    Range("b1").Resize(arrList.count + 1, 1).Value = brr
    Set arrList = Nothing: Set arrList2 = Nothing
End Sub

结果


5，删除办法

ArrayList.Clear

直接全部干掉了
ArrayList.Remove item

item必须是添加进去的内容，不支持索引这里

Sub lizi2()
    Dim arrList As Object, i As Long
    Dim arrList2 As Object, brr()
    Set arrList = CreateObject("System.Collections.ArrayList")
    Set arrList2 = CreateObject("System.Collections.ArrayList")
    arrList.Add 1: arrList.Add 11: arrList.Add 9
    arrList.Add 5: arrList.Add 6: arrList.Insert 0, 10
    Set arrList2 = arrList.Clone
    arrList.Remove 11  '删除item是11的内容
    arrList.Sort
    arrList.Reverse  '降序
    '下面内容全部是返回单元格
    ReDim brr(1 To arrList.count + 1, 1 To 1)
    For i = 0 To arrList.count - 1
        brr(i + 1, 1) = arrList(i)
    Next
    Range("a1").Resize(arrList.count + 1, 1).Value = brr
    ReDim brr(1 To arrList.count + 1, 1 To 1)
    For i = 0 To arrList2.count - 1
        brr(i + 1, 1) = arrList2(i)
    Next
    Range("b1").Resize(arrList.count + 1, 1).Value = brr
    Set arrList = Nothing: Set arrList2 = Nothing
End Sub

显示结果


6，可以直接复制成一个数组

ToArray方法

Sub lizi2()
    Dim arrList As Object, i As Long
    Dim arrList2 As Object, brr()
    Set arrList = CreateObject("System.Collections.ArrayList")
    arrList.Add 1: arrList.Add 11: arrList.Add 9
    arrList.Add 5: arrList.Add 6: arrList.Insert 0, 10
    brr = arrList.toarray  '从0开始的一维数组
    Range("a1").Resize(UBound(brr) + 1, 1).Value = _
            Application.WorksheetFunction.Transpose(brr)
    Set arrList = Nothing
End Sub

因为这个，只有单纯的item不能进行更为快速的查找，有没有一个对象，可以再添加进去的过程中就排好序呢？
下次分享更为健全的SortedList对象使用
学习来源：完美Excel微信公众号，感谢大佬的无私分享