myarray1 = ActiveSheet.Range("A1:A10").Value
myarray2 = ActiveSheet.Range("B1:B10").Value
myarray3 = ActiveSheet.Range("C1:C10").Value
ReDim finalarray(1 To UBound(myarray1) + UBound(myarray2) + UBound(myarray3), 1 To 1)
j = 1
For i = 1 To UBound(myarray1)
finalarray(j, 1) = myarray1(i, 1)
j = j + 1
Next i
For i = 1 To UBound(myarray2)
finalarray(j, 1) = myarray2(i, 1)
j = j + 1
Next i
For i = 1 To UBound(myarray3)
finalarray(j, 1) = myarray3(i, 1)
j = j + 1
Next i
ActiveSheet.Range("D1:D30").Value = finalarray
Public Sub LoadWithADODB()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, strSQL As String
Dim a As Variant
Set cn = New ADODB.Connection
' **** You need the commented connection string for Excel 2003 or earlier
'cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
Set rs = New ADODB.Recordset
strSQL = " SELECT Col1 As Cons FROM [Sheet1$] " & _
" UNION ALL SELECT Col2 As Cons FROM [Sheet1$] " & _
" UNION ALL SELECT Col3 As Cons FROM [Sheet1$] " & _
""
'" ORDER BY Cons"
Debug.Print "Opening recordset"
rs.Open strSQL, cn
If Not rs.EOF Then
Debug.Print "getting rows"
a = rs.GetRows
End If
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Sub ss()
Dim a As Variant
Debug.Print "Getting data"
a = [a1:c1000000].Value
Debug.Print "Sorting...."
Call QSort2D(a, 1, 3000000)
Debug.Print "Replacing"
[e1:g1000000].Value = a
End Sub
Sub QSort2D(sortArray As Variant, ByVal leftIndex As Variant, ByVal rightIndex As Variant)
Dim compValue As Variant
Dim i As Long, j As Long
Dim i1 As Long, i2 As Long
Dim j1 As Long, j2 As Long
Dim tempVar As Variant
Dim upper As Long
Dim comp1 As Long, comp2 As Long
upper = UBound(sortArray, 1)
i = leftIndex
j = rightIndex
i2 = ((i - 1) \ upper) + 1
i1 = ((i - 1) Mod upper) + 1
j2 = ((j - 1) \ upper) + 1
j1 = ((j - 1) Mod upper) + 1
comp2 = ((((i + j) \ 2) - 1) \ upper) + 1
comp1 = ((((i + j) \ 2) - 1) Mod upper) + 1
compValue = sortArray(comp1, comp2)
Do
Do While (sortArray(i1, i2) < compValue And i < rightIndex)
i = i + 1
i2 = ((i - 1) \ upper) + 1
i1 = ((i - 1) Mod upper) + 1
Loop
Do While (compValue < sortArray(j1, j2) And j > leftIndex)
j = j - 1
j2 = ((j - 1) \ upper) + 1
j1 = ((j - 1) Mod upper) + 1
Loop
If i <= j Then
tempVar = sortArray(i1, i2)
sortArray(i1, i2) = sortArray(j1, j2)
sortArray(j1, j2) = tempVar
i = i + 1
j = j - 1
i2 = ((i - 1) \ upper) + 1
i1 = ((i - 1) Mod upper) + 1
j2 = ((j - 1) \ upper) + 1
j1 = ((j - 1) Mod upper) + 1
End If
Loop While i <= j
If leftIndex < j Then QSort2D sortArray, leftIndex, j
If i < rightIndex Then QSort2D sortArray, i, rightIndex
End Sub
If you are experiencing a similar issue, please ask a related question
Join the community of 500,000 technology professionals and ask your questions.