Скачать или смотреть Excel高級技巧(25)VBA大數據(超過1048576列)快速排序及陣列高效處理(2)

三個工作表共有3百萬列大數據資料，如何合併排序?
超過Excel最大列的1048576大數據，如何利用陣列高效處理，比利用儲存格處理，速度超過百倍，這是身為VBA的愛好者，首需了解的。
軟體下載 https://www.skvba.com/1
範例下載 https://www.skvba.com/1Q
如有相關問題，歡迎加入個人FB社團:OutLook自動化，與本人討論，謝謝。

本次範例程式碼如下:
Sub 二維陣列排序解說()
Dim addIn As COMAddIn
Dim sk As Object
'以下引用南俠增益集 ExcelAddIn_SouthKnight 是固定名稱
Set addIn = Application.COMAddIns("ExcelAddIn_SouthKnight")
Set sk = addIn.Object
Dim arr As Variant
arr = mydata.Range("A1").CurrentRegion ' mydata 或者用sheets("工作表1")
Dim MaxRow As Long
Dim MaxCol As Long
Dim MinRow As Long
Dim MinCol As Long
MaxRow = UBound(arr, 1) '最高列數
MaxCol = UBound(arr, 2) '最高行數
MinRow = LBound(arr, 1) '最低列數
MinCol = LBound(arr, 2) '最低行數
MsgBox "最高列數:" & MaxRow & " 最高行數:" & MaxCol & " 最低列數:" & MinRow & " 最低行數:" & MinCol
'二維陣列排序
'函式qse3是 QuickSort Excel 3 快速排序excel
'第1個參數為Variant的二為陣列 arr
'第2個參數為排序範圍開始列 MinRow
'第3個參數為排序範圍結束列 MaxRow
'第4個參數為排序範圍開始欄 MinCol
'第5個參數為排序範圍結束欄 MaxCol
'第6個參數為排序的欄位順序陣列 si
'第7個參數為是否由大至小排序陣列 sf
Dim si(2) As Long: si(0) = 1: si(1) = 2: si(2) = 3
Dim sf(2) As Boolean: sf(0) = True
sk.qse3 arr, MinRow, MaxRow, MinCol, MaxCol, si, sf
Sheets("工作表2").Range("A1").Resize(MaxRow, MaxCol).Value = arr ' sheets("工作表2") 或者用 mydata2
MsgBox ("ok")
End Sub
Sub 大數據工作表合併排序()
Dim addIn As COMAddIn
Dim sk As Object
'以下引用南俠增益集 ExcelAddIn_SouthKnight 是固定名稱
Set addIn = Application.COMAddIns("ExcelAddIn_SouthKnight")
Set sk = addIn.Object
Dim maxRow As Long 'Excel每頁最大列數
maxRow = 1048576
Dim v(2999999, 4) As Variant '陣列基底為0 三個工作表列數共 1048576+1048576+902848=3000000
Dim arr As Variant
Dim s1 As Double, s2 As Double
Dim i As Long
'工作表1匯入
s1 = Timer
arr = 工作表1.Range("A1:E" & maxRow)
s2 = Timer
i = i + 1
工作表4.Cells(i, 1).Value = "工作表1匯入" & maxRow & "筆資料至陣列共" & (s2 - s1) & "秒"
s1 = Timer
'以下ac函式是利用vb.net的Array.copy 的函式功能來增強VBA，ac是取 Array copy 英文首字
'第1個參數:為要被複製讀取的來源陣列變數名稱，本範例為arr陣列
'第 2個參數:為要被複製的來源陣列的開始位置，本範例為從基底1開始複製
'第3個參數:為要被複製寫入的目標陣列變數名稱，本範例為v陣列
'第4個參數: 為要被複製寫入的開始位置 , 本範例為從0開始
'第5個參數: 為要被複製寫入的長度 , 工作表最大列*最大行
sk.ac arr, 1, v, 0, maxRow * 5
s2 = Timer
i = i + 1
工作表4.Cells(i, 1).Value = "第1次陣列arr " & maxRow & "筆複製到v陣列共" & (s2 - s1) & "秒"

'工作表2匯入
s1 = Timer
arr = 工作表2.Range("A1:E" & maxRow)
s2 = Timer
i = i + 1
工作表4.Cells(i, 1).Value = "工作表2匯入" & maxRow & "筆資料至陣列共" & (s2 - s1) & "秒"
s1 = Timer
'以下ac函式是利用vb.net的Array.copy 的函式功能來增強VBA，ac是取 Array copy 英文首字
'第1個參數:為要被複製讀取的來源陣列變數名稱，本範例為arr陣列
'第 2個參數:為要被複製的來源陣列的開始位置，本範例為從基底1開始複製
'第3個參數:為要被複製寫入的目標陣列變數名稱，本範例為v陣列
'第4個參數: 為要被複製寫入的開始位置 , 第2個工作表要從 maxRow * 5 開始
'第5個參數: 為要被複製寫入的長度 , 工作表最大列*最大行
sk.ac arr, 1, v, maxRow * 5, maxRow * 5
s2 = Timer
i = i + 1
工作表4.Cells(i, 1).Value = " 第2次陣列arr " & maxRow & "筆複製到v陣列共" & (s2 - s1) & "秒"

'工作表3匯入
s1 = Timer
arr = 工作表3.Range("A1:E902848") '3000000 -1048576-1048576= 902848
s2 = Timer
i = i + 1
工作表4.Cells(i, 1).Value = "工作表3匯入" & "902848筆資料至陣列共" & (s2 - s1) & "秒"
s1 = Timer
'以下ac函式是利用vb.net的Array.copy 的函式功能來增強VBA，ac是取 Array copy 英文首字
'第1個參數:為要被複製讀取的來源陣列變數名稱，本範例為arr陣列
'第 2個參數:為要被複製的來源陣列的開始位置，本範例為從基底1開始複製
'第3個參數:為要被複製寫入的目標陣列變數名稱，本範例為v陣列
'第4個參數: 為要被複製寫入的開始位置 , 第3個工作表要從 maxRow * 2 * 5 開始
'第5個參數: 為要被複製寫入的長度 , 第3個工作表最大列902848*最大行
sk.ac arr, 1, v, maxRow * 2 * 5, 902848 * 5
s2 = Timer
i = i + 1
工作表4.Cells(i, 1).Value = "第3次陣列arr " & "902848筆複製到v陣列共" & (s2 - s1) & "秒"
Dim si(2) As Long: si(0) = 0: si(1) = 1: si(2) = 2 '要排序的順序陣列0、1、2
Dim sf(2) As Boolean: sf(1) = True ' TRUE 代表由大排到小
s1 = Timer
'函式qse3是 QuickSort Excel 3 快速排序excel
'同上
sk.qse3 v, 0, 2999999, 0, 4, si, sf

s2 = Timer
i = i + 1
工作表4.Cells(i, 1).Value = "3百萬筆二維陣列，三個順序快速排序共" & (s2 - s1) & "秒"
s1 = 大數據陣列寫入工作表Variaint(3000000, maxRow, 5, v)
i = i + 1
工作表4.Cells(i, 1).Value = "排序好的3百萬筆二維陣列，依序寫入三個工作表A1~A3共" & s1 & "秒"
MsgBox "ok"

End Sub
Function 大數據陣列寫入工作表Variaint(r As Long, m As Long, c As Long, a As Variant) As Double
Dim s1 As Double, s2 As Double, i As Long, j As Long
s1 = Timer
Dim addIn As COMAddIn
Dim sk As Object
'以下引用南俠增益集 ExcelAddIn_SouthKnight 是固定名稱
Set addIn = Application.COMAddIns("ExcelAddIn_SouthKnight")
Set sk = addIn.Object
Dim b() As Variant
ReDim b(m - 1, c - 1)
m2 = Int(r / m)
m3 = r Mod m
Dim w As Worksheet
i = 0
For n = 0 To r Step m
i = i + 1
If i 小於等於 m2 Then
sk.ac a, (i - 1) * m * c, b, 0, m * c
Set w = ThisWorkbook.Sheets.Add
w.Name = "A" & (i)
w.Range("A1").Resize(m, c).Value = b
Else
If m3 大於 0 Then
ReDim b(m3 - 1, c - 1)
sk.ac a, (i - 1) * m * c, b, 0, m3 * c
Set w = ThisWorkbook.Sheets.Add
w.Name = "A" & (i)
w.Range("A1").Resize(m3, c).Value = b
End If
End If
Next n
s2 = Timer
大數據陣列寫入工作表Variaint = s2 - s1
End Function