Code:
' https://usefulgyaan.wordpress.com/2013/06/12/vba-trick-of-the-week-slicing-an-array-without-loop-application-index/comment-page-1/#comment-587
Sub M_snbSortof() ' http://www.snb-vba.eu/VBA_Arraylist_en.html#L_11.3
Dim rngVoll As Range: Set rngVoll = Tabelle3.Range("A1:E10")
Dim snAll() As Variant, Sported() As Variant
Let snAll() = rngVoll.Value
Dim j As Long, jj As Long
With CreateObject("System.Collections.Arraylist")
For j = 1 To UBound(snAll(), 1)
.Add snAll(j, 3)
Next
.Sort
Let Sported() = .ToArray
.Clear
For j = 0 To UBound(Sported())
For jj = 1 To UBound(snAll(), 1)
If snAll(jj, 3) = Sported(j) Then
' Use Range to overcome Array size Limits of Worksheets Functions
'Dim Clm As Range: Set Clm = Application.Index(rngVoll, jj, 0)
' .Add Clm.Value
' .Add (Application.Index(rngVoll, jj, 0).Value)
' Use Cells to overcome Array size Limits of Worksheets Functions
Dim LB As Long, UB As Long '…User Given start and Stop Column as a Number
Let LB = LBound(snAll(), 2): Let UB = UBound(snAll(), 2)
Dim strLtrLB As String, strLtrUB As String '…Column Letter corresponding to Column Number
'There are many ways to get a Column Letter from a Column Number – excelforum.com/tips-and-tutorials/1108643-vba-column-letter-from-column-number-explained.html
Let strLtrLB = Split(Cells(1, LB).Address, "$")(1) 'An Address Method
Let strLtrUB = Replace (Replace(Cells(1, UB).Address, "1", ""), "$", "") 'A Replace Method
'Obtain Column Indicies using Spreadsheet Function Column via VBA Evaluate Method
Dim clms() As Variant
Let clms() = Evaluate("column(" & strLtrLB & ":" & strLtrUB & ")") 'Returns 1 D “pseudo” Horizontal Array of sequential numbers from column number of LB to UB
'Or
clms() = Evaluate("column(" & Split(Cells(1, LB).Address, "$")(1) & ":" & Replace (Replace(Cells(1, UB).Address, "1", ""), "$", "") & ")")
.Add (Application.Index(Tabelle3.Cells, jj, clms()))
'Let snAll(jj, 3) = ""
Exit For
End If
Next jj
Next j
For j = 0 To .Count - 1
Tabelle3.Cells(j + 1 + 10, 1).Resize(, UBound(snAll, 2)) = .Item(j)
Next j
End With
End Sub
'
Sub M_snb()
Dim sn, sp, j As Long, jj As Long
sn = Tabelle3.Range("A1:E10")
With CreateObject("System.Collections.Arraylist")
For j = 1 To UBound(sn)
.Add sn(j, 3)
Next
.Sort
sp = .ToArray
.Clear
For j = 0 To UBound(sp)
For jj = 1 To UBound(sn)
If sn(jj, 3) = sp(j) Then
.Add Application.Index(sn, jj)
sn(jj, 3) = ""
Exit For
End If
Next
Next
For j = 0 To .Count - 1
Tabelle3.Cells((j + 1) + 10, 1).Resize(, UBound(sn, 2)) = .Item(j)
Next
End With
End Sub
'Rem Ref
' http://www.excelforum.com/excel-programming-vba-macros/1139207-how-to-move-a-userform-and-module-from-one-book-to-another-2.html
' http://www.excelforum.com/excel-programming-vba-macros/1138300-vba-userform-value-check-if-user-form-buttons-checked-not-working-check-button-on-open.html
' http://www.excelforum.com/excel-programming-vba-macros/1139742-workbooks_open-crashes-when-file-opened-with-code-manually-open-ok-userform-issue.html
' http://www.excelfox.com/forum/showthread.php/2130-Sort-an-array-based-on-another-array-VBA?p=9985#post9985
' http://www.snb-vba.eu/VBA_Arraylist_en.html
' http://www.snb-vba.eu/VBA_Arraylist_en.html#L_11.3
' http://www.excelforum.com/showthread.php?t=1154829&page=4#post4502593
' http://www.excelforum.com/excel-programming-vba-macros/1160648-how-to-create-a-pop-up-notification-for-two-different-conditions-at-the-same-time.html#post4507157
' http://www.excelfox.com/forum/showthread.php/2130-Sort-an-array-based-on-another-array-VBA?p=9985#post9985
Reply With Quote
Bookmarks