DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Test4()
Dim arrData() As Variant
Dim sortedList() As Variant
arrData = Array("8c1", "8b2", "8z1", "8a3", "5c3")
MsgBox "Sıralamasız liste:" & vbCrLf & vbCrLf & Join(arrData, vbCrLf)
Call sortNatural4(arrData, sortedList)
MsgBox "Sıralı Liste:" & vbCrLf & vbCrLf & Join(sortedList, vbCrLf)
End Sub
'
Sub sortNatural4(ByRef myArr() As Variant, ByRef sortedList() As Variant)
' Haluk - 06/03/2020
' sa4truss@gmail.com
' Subject: Natural Sort of strings
Dim objRS As Object, XData As Variant
Dim sWord, myTable() As Variant
Dim i As Integer, j As Byte
Const adVarChar = 200
Const adInteger = 3
Set objRS = CreateObject("ADODB.Recordset")
objRS.Fields.Append "Field1", adInteger
objRS.Fields.Append "Field2", adVarChar, 1
objRS.Fields.Append "Field3", adInteger
objRS.Open
For Each XData In myArr
objRS.AddNew
objRS.Fields("Field1").Value = Left(XData, 1)
objRS.Fields("Field2").Value = Mid(XData, 2, 1)
objRS.Fields("Field3").Value = Right(XData, 1)
Next
objRS.Update
objRS.Sort = "Field1, Field2, Field3"
myTable() = objRS.GetRows()
ReDim sortedList(UBound(myTable, 2))
For i = 0 To UBound(sortedList)
sortedList(i) = myTable(0, i) & myTable(1, i) & myTable(2, i)
Next
objRS.Close
Erase myTable()
Set objRS = Nothing
End Sub