Can you sort one cell or a string in vba?
Say you have a string="14386ah"
Is there a excel vba function that will sort the string? Thanks JOhn |
Can you sort one cell or a string in vba?
You need to perfrom a buble sort manually using code
Sub bubbleSort() Mystring = "14386ah" For i = 1 To (Len(Mystring) - 1) For j = (i + 1) To Len(Mystring) char_i = Mid(Mystring, i, 1) char_j = Mid(Mystring, j, 1) If Asc(char_i) Asc(char_j) Then 'switch character Mid(Mystring, i, 1) = char_j Mid(Mystring, j, 1) = char_i End If Next j Next i End Sub "John" wrote: Say you have a string="14386ah" Is there a excel vba function that will sort the string? Thanks JOhn |
Can you sort one cell or a string in vba?
If you are dealing with large strings and speed is important then you could
use code like this. Not tested, but I think it will be faster than a bubblesort. Sub test() Dim str As String str = "azyxwvutsrqponmlkjihgfedcba" MsgBox SortString(str) End Sub Function SortString(strString As String) As String Dim btArray() As Byte Dim btArray2() As Byte btArray = strString btArray2 = CountingSortByte1D(btArray) SortString = ByteArrayToString(btArray2) End Function Function ByteArrayToString(btArray() As Byte) As String Dim sAns As String Dim lPos As Long sAns = StrConv(btArray, vbUnicode) lPos = InStr(sAns, Chr(0)) If lPos 0 Then sAns = Left(sAns, lPos - 1) End If ByteArrayToString = sAns End Function Function CountingSortByte1D(arrByte() As Byte) As Byte() Dim i As Long Dim LB As Long Dim UB As Long Dim arrCount() As Long Dim arrByteSorted() As Byte Dim lThisCount As Long Dim lNext_Offset As Long LB = LBound(arrByte) UB = UBound(arrByte) 'Create the Counts array ReDim arrCount(0 To 255) 'create the sorted return array ReDim arrByteSorted(LB To UB \ 2) As Byte 'Count the items For i = LB To UB Step 2 arrCount(arrByte(i)) = arrCount(arrByte(i)) + 1 Next i 'Convert the arrCount into offsets lNext_Offset = LB For i = 0 To 255 lThisCount = arrCount(i) arrCount(i) = lNext_Offset lNext_Offset = lNext_Offset + lThisCount Next i 'Place the items in the sorted array For i = LB To UB Step 2 arrByteSorted(arrCount(arrByte(i))) = arrByte(i) arrCount(arrByte(i)) = arrCount(arrByte(i)) + 1 Next i CountingSortByte1D = arrByteSorted End Function RBS "John" wrote in message ... Say you have a string="14386ah" Is there a excel vba function that will sort the string? Thanks JOhn |
Can you sort one cell or a string in vba?
Here is my attempt at a solution. Place the following in a general Module
(Insert/Module from the VB editor's menu bar)... Function SortCharacters(S As String) As String Dim X As Long, Z As Long, Cnt As Long ReDim C(1 To Len(S)) As Long For X = 1 To Len(S) For Z = 1 To Len(S) If Mid(S, Z, 1) < Mid(S, X, 1) Then C(X) = C(X) + 1 Next Next SortCharacters = Space(Len(S)) For X = 1 To Len(S) Mid(SortCharacters, C(X) + 1, 1) = Mid(S, X, 1) Next End Function Just call this function from your own code passing the text you want to sort. As an example... MyString = "14386ah" MsgBox SortCharacters(MyString) This function can also be used as a UDF (user defined function) on the worksheet as well. As an example... =SortCharacters(A1) -- Rick (MVP - Excel) "John" wrote in message ... Say you have a string="14386ah" Is there a excel vba function that will sort the string? Thanks JOhn |
Can you sort one cell or a string in vba?
Thanks... I've been using somthing like that. i just thought vba would
have something more elegant JOhn Rick Rothstein wrote: Here is my attempt at a solution. Place the following in a general Module (Insert/Module from the VB editor's menu bar)... Function SortCharacters(S As String) As String Dim X As Long, Z As Long, Cnt As Long ReDim C(1 To Len(S)) As Long For X = 1 To Len(S) For Z = 1 To Len(S) If Mid(S, Z, 1) < Mid(S, X, 1) Then C(X) = C(X) + 1 Next Next SortCharacters = Space(Len(S)) For X = 1 To Len(S) Mid(SortCharacters, C(X) + 1, 1) = Mid(S, X, 1) Next End Function Just call this function from your own code passing the text you want to sort. As an example... MyString = "14386ah" MsgBox SortCharacters(MyString) This function can also be used as a UDF (user defined function) on the worksheet as well. As an example... =SortCharacters(A1) |
Can you sort one cell or a string in vba?
Thanks. Been using something like this. I thought vba would have
something more elegant. John Joel wrote: You need to perfrom a buble sort manually using code Sub bubbleSort() Mystring = "14386ah" For i = 1 To (Len(Mystring) - 1) For j = (i + 1) To Len(Mystring) char_i = Mid(Mystring, i, 1) char_j = Mid(Mystring, j, 1) If Asc(char_i) Asc(char_j) Then 'switch character Mid(Mystring, i, 1) = char_j Mid(Mystring, j, 1) = char_i End If Next j Next i End Sub "John" wrote: Say you have a string="14386ah" Is there a excel vba function that will sort the string? Thanks JOhn |
Can you sort one cell or a string in vba?
One more, normally will want to sort "BAab" to "AaBb"
Function SortString(ByVal strIn) As String Dim i As Long, j As Long Dim s1 As String, s2 As String For i = 1 To (Len(strIn) - 1) For j = (i + 1) To Len(strIn) s1 = Mid$(strIn, i, 1) s2 = Mid$(strIn, j, 1) If StrComp(s1, s2, vbTextCompare) = 1 Then Mid$(strIn, i, 1) = s2 Mid$(strIn, j, 1) = s1 End If Next j Next i SortString = strIn End Function Regards, Peter T "John" wrote in message ... Say you have a string="14386ah" Is there a excel vba function that will sort the string? Thanks JOhn |
Can you sort one cell or a string in vba?
Try this string:
"ZZYYyy22222211111" Not that may suggestion is perfect, but very fast though :-) RBS "Rick Rothstein" wrote in message ... Here is my attempt at a solution. Place the following in a general Module (Insert/Module from the VB editor's menu bar)... Function SortCharacters(S As String) As String Dim X As Long, Z As Long, Cnt As Long ReDim C(1 To Len(S)) As Long For X = 1 To Len(S) For Z = 1 To Len(S) If Mid(S, Z, 1) < Mid(S, X, 1) Then C(X) = C(X) + 1 Next Next SortCharacters = Space(Len(S)) For X = 1 To Len(S) Mid(SortCharacters, C(X) + 1, 1) = Mid(S, X, 1) Next End Function Just call this function from your own code passing the text you want to sort. As an example... MyString = "14386ah" MsgBox SortCharacters(MyString) This function can also be used as a UDF (user defined function) on the worksheet as well. As an example... =SortCharacters(A1) -- Rick (MVP - Excel) "John" wrote in message ... Say you have a string="14386ah" Is there a excel vba function that will sort the string? Thanks JOhn |
Can you sort one cell or a string in vba?
Picky... picky... picky <g
Okay, this modification should work correctly... Function SortCharacters(ByVal S As String) As String Dim X As Long, Z As Long, Cnt As Long ReDim C(1 To Len(S)) As Long For X = 1 To Len(S) For Z = 1 To Len(S) If Mid(S, Z, 1) <= Mid(S, X, 1) Then C(X) = C(X) + 1 Next Next SortCharacters = String(Len(S), Chr$(1)) For X = 1 To Len(S) Mid(SortCharacters, C(X), 1) = Mid(S, X, 1) Next For X = Len(S) - 1 To 1 Step -1 If Mid(SortCharacters, X, 1) = Chr$(1) Then Mid(SortCharacters, X, 1) = Mid(SortCharacters, X + 1, 1) End If Next End Function I'm not sure how it would compare speedwise with your (or any other) routine, but I don't think it will be a slouch by any means (that's a gut feeling based on past experience with the "string stuffing" method I have employed). Anyway, the assumed size of the text string the function would be used with probably makes differences in efficiency moot. -- Rick (MVP - Excel) "RB Smissaert" wrote in message ... Try this string: "ZZYYyy22222211111" Not that may suggestion is perfect, but very fast though :-) RBS "Rick Rothstein" wrote in message ... Here is my attempt at a solution. Place the following in a general Module (Insert/Module from the VB editor's menu bar)... Function SortCharacters(S As String) As String Dim X As Long, Z As Long, Cnt As Long ReDim C(1 To Len(S)) As Long For X = 1 To Len(S) For Z = 1 To Len(S) If Mid(S, Z, 1) < Mid(S, X, 1) Then C(X) = C(X) + 1 Next Next SortCharacters = Space(Len(S)) For X = 1 To Len(S) Mid(SortCharacters, C(X) + 1, 1) = Mid(S, X, 1) Next End Function Just call this function from your own code passing the text you want to sort. As an example... MyString = "14386ah" MsgBox SortCharacters(MyString) This function can also be used as a UDF (user defined function) on the worksheet as well. As an example... =SortCharacters(A1) -- Rick (MVP - Excel) "John" wrote in message ... Say you have a string="14386ah" Is there a excel vba function that will sort the string? Thanks JOhn |
Can you sort one cell or a string in vba?
The code I posted had a flaw in that it didn't sort AaBbCc etc.
With a simple byte converter this is now fixed and this carries only a very small performance penalty and it is still a lot faster than the posted bubblesorts. The strings this works on may be small, but if you use it as a worksheet UDF and it works on a lot of cells then speed could be important. I added a timing test, so you can see the difference. Option Explicit Private lStartTime As Long Private Declare Function timeGetTime Lib "winmm.dll" () As Long Private arrLookup(0 To 255) As Byte Private arrLookup2(0 To 255) As Byte Private bFilledLookupArray1 As Boolean Private bFilledLookupArray2 As Boolean Sub test() Dim i As Long Dim str As String Dim strSorted As String Dim bSortAaBb As Boolean Dim bCountingSort As Boolean Dim bUseSortCharacters As Boolean str = "ZYXWVUTSRQPONMLKJIHGFEDCBA zyxwvutsrqponmlkjihgfedcba 9876543210" If MsgBox("Use the CountingSort?", vbYesNo, "sorting string") = vbYes Then bCountingSort = True If MsgBox("Sort as AaBbCc etc.?", vbYesNo, "sorting string") = vbYes Then bSortAaBb = True End If Else If MsgBox("Use SortCharacters?", vbYesNo, "sorting string") = vbYes Then bUseSortCharacters = True End If End If StartSW If bCountingSort Then For i = 0 To 1000 strSorted = SortString(str, bSortAaBb) Next i Else If bUseSortCharacters Then For i = 0 To 1000 strSorted = SortCharacters(str) Next i Else For i = 0 To 1000 strSorted = SortString2(str) Next i End If End If StopSW MsgBox strSorted, , "sorted string" End Sub Function SortString(strString As String, Optional bSortAaBb As Boolean) As String Dim i As Long Dim btArray() As Byte Dim btArray2() As Byte btArray = strString If bSortAaBb Then If bFilledLookupArray1 = False Then FillLookupArray1 End If For i = 0 To UBound(btArray) Step 2 btArray(i) = arrLookup(btArray(i)) Next i End If btArray2 = CountingSortByte1D(btArray) If bSortAaBb Then If bFilledLookupArray2 = False Then FillLookupArray2 End If For i = 0 To UBound(btArray2) btArray2(i) = arrLookup2(btArray2(i)) Next i End If SortString = ByteArrayToString(btArray2) End Function Function SortString2(ByVal strIn) As String Dim i As Long Dim j As Long Dim s1 As String Dim s2 As String For i = 1 To (Len(strIn) - 1) For j = (i + 1) To Len(strIn) s1 = Mid$(strIn, i, 1) s2 = Mid$(strIn, j, 1) If StrComp(s1, s2, vbTextCompare) = 1 Then Mid$(strIn, i, 1) = s2 Mid$(strIn, j, 1) = s1 End If Next j Next i SortString2 = strIn End Function Function SortCharacters(ByVal S As String) As String Dim X As Long Dim Z As Long Dim Cnt As Long ReDim C(1 To Len(S)) As Long For X = 1 To Len(S) For Z = 1 To Len(S) If Mid(S, Z, 1) <= Mid(S, X, 1) Then C(X) = C(X) + 1 Next Next SortCharacters = String(Len(S), Chr$(1)) For X = 1 To Len(S) Mid(SortCharacters, C(X), 1) = Mid(S, X, 1) Next For X = Len(S) - 1 To 1 Step -1 If Mid(SortCharacters, X, 1) = Chr$(1) Then Mid(SortCharacters, X, 1) = Mid(SortCharacters, X + 1, 1) End If Next End Function Sub FillLookupArray1() arrLookup(0) = 255 arrLookup(1) = 11 arrLookup(2) = 12 arrLookup(3) = 13 arrLookup(4) = 14 arrLookup(5) = 15 arrLookup(6) = 16 arrLookup(7) = 17 arrLookup(8) = 18 arrLookup(9) = 49 arrLookup(10) = 50 arrLookup(11) = 51 arrLookup(12) = 52 arrLookup(13) = 53 arrLookup(14) = 19 arrLookup(15) = 20 arrLookup(16) = 21 arrLookup(17) = 22 arrLookup(18) = 23 arrLookup(19) = 24 arrLookup(20) = 25 arrLookup(21) = 26 arrLookup(22) = 27 arrLookup(23) = 28 arrLookup(24) = 29 arrLookup(25) = 30 arrLookup(26) = 31 arrLookup(27) = 32 arrLookup(28) = 33 arrLookup(29) = 34 arrLookup(30) = 35 arrLookup(31) = 36 arrLookup(32) = 47 arrLookup(33) = 54 arrLookup(34) = 55 arrLookup(35) = 56 arrLookup(36) = 57 arrLookup(37) = 58 arrLookup(38) = 59 arrLookup(39) = 10 arrLookup(40) = 60 arrLookup(41) = 61 arrLookup(42) = 62 arrLookup(43) = 97 arrLookup(44) = 63 arrLookup(45) = 43 arrLookup(46) = 64 arrLookup(47) = 65 arrLookup(48) = 0 arrLookup(49) = 1 arrLookup(50) = 2 arrLookup(51) = 3 arrLookup(52) = 4 arrLookup(53) = 5 arrLookup(54) = 6 arrLookup(55) = 7 arrLookup(56) = 8 arrLookup(57) = 9 arrLookup(58) = 66 arrLookup(59) = 67 arrLookup(60) = 98 arrLookup(61) = 99 arrLookup(62) = 100 arrLookup(63) = 68 arrLookup(64) = 69 arrLookup(65) = 130 arrLookup(66) = 147 arrLookup(67) = 149 arrLookup(68) = 153 arrLookup(69) = 157 arrLookup(70) = 167 arrLookup(71) = 170 arrLookup(72) = 172 arrLookup(73) = 174 arrLookup(74) = 184 arrLookup(75) = 186 arrLookup(76) = 188 arrLookup(77) = 190 arrLookup(78) = 192 arrLookup(79) = 196 arrLookup(80) = 213 arrLookup(81) = 215 arrLookup(82) = 217 arrLookup(83) = 219 arrLookup(84) = 224 arrLookup(85) = 229 arrLookup(86) = 239 arrLookup(87) = 241 arrLookup(88) = 243 arrLookup(89) = 245 arrLookup(90) = 251 arrLookup(91) = 70 arrLookup(92) = 71 arrLookup(93) = 72 arrLookup(94) = 73 arrLookup(95) = 75 arrLookup(96) = 76 arrLookup(97) = 131 arrLookup(98) = 148 arrLookup(99) = 150 arrLookup(100) = 154 arrLookup(101) = 158 arrLookup(102) = 168 arrLookup(103) = 171 arrLookup(104) = 173 arrLookup(105) = 175 arrLookup(106) = 185 arrLookup(107) = 187 arrLookup(108) = 189 arrLookup(109) = 191 arrLookup(110) = 193 arrLookup(111) = 197 arrLookup(112) = 214 arrLookup(113) = 216 arrLookup(114) = 218 arrLookup(115) = 220 arrLookup(116) = 225 arrLookup(117) = 230 arrLookup(118) = 240 arrLookup(119) = 242 arrLookup(120) = 244 arrLookup(121) = 246 arrLookup(122) = 252 arrLookup(123) = 77 arrLookup(124) = 78 arrLookup(125) = 79 arrLookup(126) = 80 arrLookup(127) = 37 arrLookup(128) = 123 arrLookup(129) = 38 arrLookup(130) = 91 arrLookup(131) = 169 arrLookup(132) = 94 arrLookup(133) = 121 arrLookup(134) = 118 arrLookup(135) = 119 arrLookup(136) = 74 arrLookup(137) = 122 arrLookup(138) = 221 arrLookup(139) = 95 arrLookup(140) = 211 arrLookup(141) = 39 arrLookup(142) = 253 arrLookup(143) = 40 arrLookup(144) = 41 arrLookup(145) = 89 arrLookup(146) = 90 arrLookup(147) = 92 arrLookup(148) = 93 arrLookup(149) = 120 arrLookup(150) = 45 arrLookup(151) = 46 arrLookup(152) = 88 arrLookup(153) = 228 arrLookup(154) = 222 arrLookup(155) = 96 arrLookup(156) = 212 arrLookup(157) = 42 arrLookup(158) = 254 arrLookup(159) = 249 arrLookup(160) = 48 arrLookup(161) = 81 arrLookup(162) = 106 arrLookup(163) = 107 arrLookup(164) = 108 arrLookup(165) = 109 arrLookup(166) = 82 arrLookup(167) = 110 arrLookup(168) = 83 arrLookup(169) = 111 arrLookup(170) = 132 arrLookup(171) = 102 arrLookup(172) = 112 arrLookup(173) = 44 arrLookup(174) = 113 arrLookup(175) = 84 arrLookup(176) = 114 arrLookup(177) = 101 arrLookup(178) = 128 arrLookup(179) = 129 arrLookup(180) = 85 arrLookup(181) = 115 arrLookup(182) = 116 arrLookup(183) = 117 arrLookup(184) = 86 arrLookup(185) = 127 arrLookup(186) = 198 arrLookup(187) = 103 arrLookup(188) = 124 arrLookup(189) = 125 arrLookup(190) = 126 arrLookup(191) = 87 arrLookup(192) = 135 arrLookup(193) = 133 arrLookup(194) = 137 arrLookup(195) = 141 arrLookup(196) = 139 arrLookup(197) = 143 arrLookup(198) = 145 arrLookup(199) = 151 arrLookup(200) = 161 arrLookup(201) = 159 arrLookup(202) = 163 arrLookup(203) = 165 arrLookup(204) = 178 arrLookup(205) = 176 arrLookup(206) = 180 arrLookup(207) = 182 arrLookup(208) = 155 arrLookup(209) = 194 arrLookup(210) = 201 arrLookup(211) = 199 arrLookup(212) = 203 arrLookup(213) = 207 arrLookup(214) = 205 arrLookup(215) = 104 arrLookup(216) = 209 arrLookup(217) = 233 arrLookup(218) = 231 arrLookup(219) = 235 arrLookup(220) = 237 arrLookup(221) = 247 arrLookup(222) = 226 arrLookup(223) = 223 arrLookup(224) = 136 arrLookup(225) = 134 arrLookup(226) = 138 arrLookup(227) = 142 arrLookup(228) = 140 arrLookup(229) = 144 arrLookup(230) = 146 arrLookup(231) = 152 arrLookup(232) = 162 arrLookup(233) = 160 arrLookup(234) = 164 arrLookup(235) = 166 arrLookup(236) = 179 arrLookup(237) = 177 arrLookup(238) = 181 arrLookup(239) = 183 arrLookup(240) = 156 arrLookup(241) = 195 arrLookup(242) = 202 arrLookup(243) = 200 arrLookup(244) = 204 arrLookup(245) = 208 arrLookup(246) = 206 arrLookup(247) = 105 arrLookup(248) = 210 arrLookup(249) = 234 arrLookup(250) = 232 arrLookup(251) = 236 arrLookup(252) = 238 arrLookup(253) = 248 arrLookup(254) = 227 arrLookup(255) = 250 bFilledLookupArray1 = True End Sub Sub FillLookupArray2() arrLookup2(0) = 48 arrLookup2(1) = 49 arrLookup2(2) = 50 arrLookup2(3) = 51 arrLookup2(4) = 52 arrLookup2(5) = 53 arrLookup2(6) = 54 arrLookup2(7) = 55 arrLookup2(8) = 56 arrLookup2(9) = 57 arrLookup2(10) = 39 arrLookup2(11) = 1 arrLookup2(12) = 2 arrLookup2(13) = 3 arrLookup2(14) = 4 arrLookup2(15) = 5 arrLookup2(16) = 6 arrLookup2(17) = 7 arrLookup2(18) = 8 arrLookup2(19) = 14 arrLookup2(20) = 15 arrLookup2(21) = 16 arrLookup2(22) = 17 arrLookup2(23) = 18 arrLookup2(24) = 19 arrLookup2(25) = 20 arrLookup2(26) = 21 arrLookup2(27) = 22 arrLookup2(28) = 23 arrLookup2(29) = 24 arrLookup2(30) = 25 arrLookup2(31) = 26 arrLookup2(32) = 27 arrLookup2(33) = 28 arrLookup2(34) = 29 arrLookup2(35) = 30 arrLookup2(36) = 31 arrLookup2(37) = 127 arrLookup2(38) = 129 arrLookup2(39) = 141 arrLookup2(40) = 143 arrLookup2(41) = 144 arrLookup2(42) = 157 arrLookup2(43) = 45 arrLookup2(44) = 173 arrLookup2(45) = 150 arrLookup2(46) = 151 arrLookup2(47) = 32 arrLookup2(48) = 160 arrLookup2(49) = 9 arrLookup2(50) = 10 arrLookup2(51) = 11 arrLookup2(52) = 12 arrLookup2(53) = 13 arrLookup2(54) = 33 arrLookup2(55) = 34 arrLookup2(56) = 35 arrLookup2(57) = 36 arrLookup2(58) = 37 arrLookup2(59) = 38 arrLookup2(60) = 40 arrLookup2(61) = 41 arrLookup2(62) = 42 arrLookup2(63) = 44 arrLookup2(64) = 46 arrLookup2(65) = 47 arrLookup2(66) = 58 arrLookup2(67) = 59 arrLookup2(68) = 63 arrLookup2(69) = 64 arrLookup2(70) = 91 arrLookup2(71) = 92 arrLookup2(72) = 93 arrLookup2(73) = 94 arrLookup2(74) = 136 arrLookup2(75) = 95 arrLookup2(76) = 96 arrLookup2(77) = 123 arrLookup2(78) = 124 arrLookup2(79) = 125 arrLookup2(80) = 126 arrLookup2(81) = 161 arrLookup2(82) = 166 arrLookup2(83) = 168 arrLookup2(84) = 175 arrLookup2(85) = 180 arrLookup2(86) = 184 arrLookup2(87) = 191 arrLookup2(88) = 152 arrLookup2(89) = 145 arrLookup2(90) = 146 arrLookup2(91) = 130 arrLookup2(92) = 147 arrLookup2(93) = 148 arrLookup2(94) = 132 arrLookup2(95) = 139 arrLookup2(96) = 155 arrLookup2(97) = 43 arrLookup2(98) = 60 arrLookup2(99) = 61 arrLookup2(100) = 62 arrLookup2(101) = 177 arrLookup2(102) = 171 arrLookup2(103) = 187 arrLookup2(104) = 215 arrLookup2(105) = 247 arrLookup2(106) = 162 arrLookup2(107) = 163 arrLookup2(108) = 164 arrLookup2(109) = 165 arrLookup2(110) = 167 arrLookup2(111) = 169 arrLookup2(112) = 172 arrLookup2(113) = 174 arrLookup2(114) = 176 arrLookup2(115) = 181 arrLookup2(116) = 182 arrLookup2(117) = 183 arrLookup2(118) = 134 arrLookup2(119) = 135 arrLookup2(120) = 149 arrLookup2(121) = 133 arrLookup2(122) = 137 arrLookup2(123) = 128 arrLookup2(124) = 188 arrLookup2(125) = 189 arrLookup2(126) = 190 arrLookup2(127) = 185 arrLookup2(128) = 178 arrLookup2(129) = 179 arrLookup2(130) = 65 arrLookup2(131) = 97 arrLookup2(132) = 170 arrLookup2(133) = 193 arrLookup2(134) = 225 arrLookup2(135) = 192 arrLookup2(136) = 224 arrLookup2(137) = 194 arrLookup2(138) = 226 arrLookup2(139) = 196 arrLookup2(140) = 228 arrLookup2(141) = 195 arrLookup2(142) = 227 arrLookup2(143) = 197 arrLookup2(144) = 229 arrLookup2(145) = 198 arrLookup2(146) = 230 arrLookup2(147) = 66 arrLookup2(148) = 98 arrLookup2(149) = 67 arrLookup2(150) = 99 arrLookup2(151) = 199 arrLookup2(152) = 231 arrLookup2(153) = 68 arrLookup2(154) = 100 arrLookup2(155) = 208 arrLookup2(156) = 240 arrLookup2(157) = 69 arrLookup2(158) = 101 arrLookup2(159) = 201 arrLookup2(160) = 233 arrLookup2(161) = 200 arrLookup2(162) = 232 arrLookup2(163) = 202 arrLookup2(164) = 234 arrLookup2(165) = 203 arrLookup2(166) = 235 arrLookup2(167) = 70 arrLookup2(168) = 102 arrLookup2(169) = 131 arrLookup2(170) = 71 arrLookup2(171) = 103 arrLookup2(172) = 72 arrLookup2(173) = 104 arrLookup2(174) = 73 arrLookup2(175) = 105 arrLookup2(176) = 205 arrLookup2(177) = 237 arrLookup2(178) = 204 arrLookup2(179) = 236 arrLookup2(180) = 206 arrLookup2(181) = 238 arrLookup2(182) = 207 arrLookup2(183) = 239 arrLookup2(184) = 74 arrLookup2(185) = 106 arrLookup2(186) = 75 arrLookup2(187) = 107 arrLookup2(188) = 76 arrLookup2(189) = 108 arrLookup2(190) = 77 arrLookup2(191) = 109 arrLookup2(192) = 78 arrLookup2(193) = 110 arrLookup2(194) = 209 arrLookup2(195) = 241 arrLookup2(196) = 79 arrLookup2(197) = 111 arrLookup2(198) = 186 arrLookup2(199) = 211 arrLookup2(200) = 243 arrLookup2(201) = 210 arrLookup2(202) = 242 arrLookup2(203) = 212 arrLookup2(204) = 244 arrLookup2(205) = 214 arrLookup2(206) = 246 arrLookup2(207) = 213 arrLookup2(208) = 245 arrLookup2(209) = 216 arrLookup2(210) = 248 arrLookup2(211) = 140 arrLookup2(212) = 156 arrLookup2(213) = 80 arrLookup2(214) = 112 arrLookup2(215) = 81 arrLookup2(216) = 113 arrLookup2(217) = 82 arrLookup2(218) = 114 arrLookup2(219) = 83 arrLookup2(220) = 115 arrLookup2(221) = 138 arrLookup2(222) = 154 arrLookup2(223) = 223 arrLookup2(224) = 84 arrLookup2(225) = 116 arrLookup2(226) = 222 arrLookup2(227) = 254 arrLookup2(228) = 153 arrLookup2(229) = 85 arrLookup2(230) = 117 arrLookup2(231) = 218 arrLookup2(232) = 250 arrLookup2(233) = 217 arrLookup2(234) = 249 arrLookup2(235) = 219 arrLookup2(236) = 251 arrLookup2(237) = 220 arrLookup2(238) = 252 arrLookup2(239) = 86 arrLookup2(240) = 118 arrLookup2(241) = 87 arrLookup2(242) = 119 arrLookup2(243) = 88 arrLookup2(244) = 120 arrLookup2(245) = 89 arrLookup2(246) = 121 arrLookup2(247) = 221 arrLookup2(248) = 253 arrLookup2(249) = 159 arrLookup2(250) = 255 arrLookup2(251) = 90 arrLookup2(252) = 122 arrLookup2(253) = 142 arrLookup2(254) = 158 arrLookup2(255) = 0 bFilledLookupArray2 = True End Sub Function ByteArrayToString(btArray() As Byte) As String Dim sAns As String Dim lPos As Long sAns = StrConv(btArray, vbUnicode) lPos = InStr(sAns, Chr(0)) If lPos 0 Then sAns = Left(sAns, lPos - 1) End If ByteArrayToString = sAns End Function Function CountingSortByte1D(arrByte() As Byte) As Byte() Dim i As Long Dim LB As Long Dim UB As Long Dim arrCount() As Long Dim arrByteSorted() As Byte Dim lThisCount As Long Dim lNext_Offset As Long LB = LBound(arrByte) UB = UBound(arrByte) 'Create the Counts array ReDim arrCount(0 To 255) 'create the sorted return array ReDim arrByteSorted(LB To UB \ 2) As Byte 'Count the items For i = LB To UB Step 2 arrCount(arrByte(i)) = arrCount(arrByte(i)) + 1 Next i 'Convert the arrCount into offsets lNext_Offset = LB For i = 0 To 255 lThisCount = arrCount(i) arrCount(i) = lNext_Offset lNext_Offset = lNext_Offset + lThisCount Next i 'Place the items in the sorted array For i = LB To UB Step 2 arrByteSorted(arrCount(arrByte(i))) = arrByte(i) arrCount(arrByte(i)) = arrCount(arrByte(i)) + 1 Next i CountingSortByte1D = arrByteSorted End Function Sub StartSW() lStartTime = timeGetTime() End Sub Function StopSW(Optional bMsgBox As Boolean = True, _ Optional vMessage As Variant, _ Optional lMinimumTimeToShow As Long = -1) As Variant Dim lTime As Long lTime = timeGetTime() - lStartTime If lTime lMinimumTimeToShow Then If IsMissing(vMessage) Then StopSW = lTime Else StopSW = lTime & " - " & vMessage End If End If If bMsgBox Then If lTime lMinimumTimeToShow Then MsgBox "Done in " & lTime & " msecs", , vMessage End If End If End Function RBS "John" wrote in message ... Say you have a string="14386ah" Is there a excel vba function that will sort the string? Thanks JOhn |
Can you sort one cell or a string in vba?
Can speed it up a bit and simplify it a bit by avoiding the second
conversion array and handle the conversion back to the original characters in the counting sort: Option Explicit Private lStartTime As Long Private Declare Function timeGetTime Lib "winmm.dll" () As Long Private arrLookup(0 To 255) As Byte Private bFilledLookupArray1 As Boolean Sub test() Dim i As Long Dim str As String Dim strSorted As String Dim bSortAaBb As Boolean Dim bCountingSort As Boolean Dim bUseSortCharacters As Boolean str = "ZYXWVUTSRQPONMLKJIHGFEDCBA zyxwvutsrqponmlkjihgfedcba 9876543210 ?/<||||||¬¬¬¬,." If MsgBox("Use the CountingSort?", vbYesNo, "sorting string") = vbYes Then bCountingSort = True If MsgBox("Sort as AaBbCc etc.?", vbYesNo, "sorting string") = vbYes Then bSortAaBb = True End If Else If MsgBox("Use SortCharacters?", vbYesNo, "sorting string") = vbYes Then bUseSortCharacters = True End If End If StartSW If bCountingSort Then For i = 0 To 1000 strSorted = SortString(str, bSortAaBb) Next i Else If bUseSortCharacters Then For i = 0 To 1000 strSorted = SortCharacters(str) Next i Else For i = 0 To 1000 strSorted = SortString2(str) Next i End If End If StopSW MsgBox strSorted, , "sorted string" End Sub Function SortString(strString As String, Optional bSortAaBb As Boolean) As String Dim i As Long Dim btArray() As Byte Dim btArray2() As Byte btArray = strString btArray2 = CountingSortByte1D(btArray, bSortAaBb) SortString = ByteArrayToString(btArray2) End Function Function CountingSortByte1D(arrByte() As Byte, bSortAaBb As Boolean) As Byte() Dim i As Long Dim LB As Long Dim UB As Long Dim arrCount() As Long Dim arrByte2() As Byte Dim arrByteSorted() As Byte Dim lThisCount As Long Dim lNext_Offset As Long LB = LBound(arrByte) UB = UBound(arrByte) If bSortAaBb Then If bFilledLookupArray1 = False Then FillLookupArray1 End If ReDim arrByte2(0 To UB) As Byte For i = 0 To UB Step 2 arrByte2(i) = arrLookup(arrByte(i)) Next i End If 'Create the Counts array ReDim arrCount(0 To 255) 'create the sorted return array ReDim arrByteSorted(LB To UB \ 2) As Byte 'Count the items If bSortAaBb Then For i = LB To UB Step 2 arrCount(arrByte2(i)) = arrCount(arrByte2(i)) + 1 Next i Else For i = LB To UB Step 2 arrCount(arrByte(i)) = arrCount(arrByte(i)) + 1 Next i End If 'Convert the arrCount into offsets lNext_Offset = LB For i = 0 To 255 lThisCount = arrCount(i) arrCount(i) = lNext_Offset lNext_Offset = lNext_Offset + lThisCount Next i 'Place the items in the sorted array If bSortAaBb Then For i = LB To UB Step 2 arrByteSorted(arrCount(arrByte2(i))) = arrByte(i) arrCount(arrByte2(i)) = arrCount(arrByte2(i)) + 1 Next i Else For i = LB To UB Step 2 arrByteSorted(arrCount(arrByte(i))) = arrByte(i) arrCount(arrByte(i)) = arrCount(arrByte(i)) + 1 Next i End If CountingSortByte1D = arrByteSorted End Function Function SortString2(ByVal strIn) As String Dim i As Long Dim j As Long Dim s1 As String Dim s2 As String For i = 1 To (Len(strIn) - 1) For j = (i + 1) To Len(strIn) s1 = Mid$(strIn, i, 1) s2 = Mid$(strIn, j, 1) If StrComp(s1, s2, vbTextCompare) = 1 Then Mid$(strIn, i, 1) = s2 Mid$(strIn, j, 1) = s1 End If Next j Next i SortString2 = strIn End Function Function SortCharacters(ByVal S As String) As String Dim X As Long Dim Z As Long Dim Cnt As Long ReDim C(1 To Len(S)) As Long For X = 1 To Len(S) For Z = 1 To Len(S) If Mid(S, Z, 1) <= Mid(S, X, 1) Then C(X) = C(X) + 1 Next Next SortCharacters = String(Len(S), Chr$(1)) For X = 1 To Len(S) Mid(SortCharacters, C(X), 1) = Mid(S, X, 1) Next For X = Len(S) - 1 To 1 Step -1 If Mid(SortCharacters, X, 1) = Chr$(1) Then Mid(SortCharacters, X, 1) = Mid(SortCharacters, X + 1, 1) End If Next End Function Sub FillLookupArray1() arrLookup(0) = 255 arrLookup(1) = 11 arrLookup(2) = 12 arrLookup(3) = 13 arrLookup(4) = 14 arrLookup(5) = 15 arrLookup(6) = 16 arrLookup(7) = 17 arrLookup(8) = 18 arrLookup(9) = 49 arrLookup(10) = 50 arrLookup(11) = 51 arrLookup(12) = 52 arrLookup(13) = 53 arrLookup(14) = 19 arrLookup(15) = 20 arrLookup(16) = 21 arrLookup(17) = 22 arrLookup(18) = 23 arrLookup(19) = 24 arrLookup(20) = 25 arrLookup(21) = 26 arrLookup(22) = 27 arrLookup(23) = 28 arrLookup(24) = 29 arrLookup(25) = 30 arrLookup(26) = 31 arrLookup(27) = 32 arrLookup(28) = 33 arrLookup(29) = 34 arrLookup(30) = 35 arrLookup(31) = 36 arrLookup(32) = 47 arrLookup(33) = 54 arrLookup(34) = 55 arrLookup(35) = 56 arrLookup(36) = 57 arrLookup(37) = 58 arrLookup(38) = 59 arrLookup(39) = 10 arrLookup(40) = 60 arrLookup(41) = 61 arrLookup(42) = 62 arrLookup(43) = 97 arrLookup(44) = 63 arrLookup(45) = 43 arrLookup(46) = 64 arrLookup(47) = 65 arrLookup(48) = 0 arrLookup(49) = 1 arrLookup(50) = 2 arrLookup(51) = 3 arrLookup(52) = 4 arrLookup(53) = 5 arrLookup(54) = 6 arrLookup(55) = 7 arrLookup(56) = 8 arrLookup(57) = 9 arrLookup(58) = 66 arrLookup(59) = 67 arrLookup(60) = 98 arrLookup(61) = 99 arrLookup(62) = 100 arrLookup(63) = 68 arrLookup(64) = 69 arrLookup(65) = 130 arrLookup(66) = 147 arrLookup(67) = 149 arrLookup(68) = 153 arrLookup(69) = 157 arrLookup(70) = 167 arrLookup(71) = 170 arrLookup(72) = 172 arrLookup(73) = 174 arrLookup(74) = 184 arrLookup(75) = 186 arrLookup(76) = 188 arrLookup(77) = 190 arrLookup(78) = 192 arrLookup(79) = 196 arrLookup(80) = 213 arrLookup(81) = 215 arrLookup(82) = 217 arrLookup(83) = 219 arrLookup(84) = 224 arrLookup(85) = 229 arrLookup(86) = 239 arrLookup(87) = 241 arrLookup(88) = 243 arrLookup(89) = 245 arrLookup(90) = 251 arrLookup(91) = 70 arrLookup(92) = 71 arrLookup(93) = 72 arrLookup(94) = 73 arrLookup(95) = 75 arrLookup(96) = 76 arrLookup(97) = 131 arrLookup(98) = 148 arrLookup(99) = 150 arrLookup(100) = 154 arrLookup(101) = 158 arrLookup(102) = 168 arrLookup(103) = 171 arrLookup(104) = 173 arrLookup(105) = 175 arrLookup(106) = 185 arrLookup(107) = 187 arrLookup(108) = 189 arrLookup(109) = 191 arrLookup(110) = 193 arrLookup(111) = 197 arrLookup(112) = 214 arrLookup(113) = 216 arrLookup(114) = 218 arrLookup(115) = 220 arrLookup(116) = 225 arrLookup(117) = 230 arrLookup(118) = 240 arrLookup(119) = 242 arrLookup(120) = 244 arrLookup(121) = 246 arrLookup(122) = 252 arrLookup(123) = 77 arrLookup(124) = 78 arrLookup(125) = 79 arrLookup(126) = 80 arrLookup(127) = 37 arrLookup(128) = 123 arrLookup(129) = 38 arrLookup(130) = 91 arrLookup(131) = 169 arrLookup(132) = 94 arrLookup(133) = 121 arrLookup(134) = 118 arrLookup(135) = 119 arrLookup(136) = 74 arrLookup(137) = 122 arrLookup(138) = 221 arrLookup(139) = 95 arrLookup(140) = 211 arrLookup(141) = 39 arrLookup(142) = 253 arrLookup(143) = 40 arrLookup(144) = 41 arrLookup(145) = 89 arrLookup(146) = 90 arrLookup(147) = 92 arrLookup(148) = 93 arrLookup(149) = 120 arrLookup(150) = 45 arrLookup(151) = 46 arrLookup(152) = 88 arrLookup(153) = 228 arrLookup(154) = 222 arrLookup(155) = 96 arrLookup(156) = 212 arrLookup(157) = 42 arrLookup(158) = 254 arrLookup(159) = 249 arrLookup(160) = 48 arrLookup(161) = 81 arrLookup(162) = 106 arrLookup(163) = 107 arrLookup(164) = 108 arrLookup(165) = 109 arrLookup(166) = 82 arrLookup(167) = 110 arrLookup(168) = 83 arrLookup(169) = 111 arrLookup(170) = 132 arrLookup(171) = 102 arrLookup(172) = 112 arrLookup(173) = 44 arrLookup(174) = 113 arrLookup(175) = 84 arrLookup(176) = 114 arrLookup(177) = 101 arrLookup(178) = 128 arrLookup(179) = 129 arrLookup(180) = 85 arrLookup(181) = 115 arrLookup(182) = 116 arrLookup(183) = 117 arrLookup(184) = 86 arrLookup(185) = 127 arrLookup(186) = 198 arrLookup(187) = 103 arrLookup(188) = 124 arrLookup(189) = 125 arrLookup(190) = 126 arrLookup(191) = 87 arrLookup(192) = 135 arrLookup(193) = 133 arrLookup(194) = 137 arrLookup(195) = 141 arrLookup(196) = 139 arrLookup(197) = 143 arrLookup(198) = 145 arrLookup(199) = 151 arrLookup(200) = 161 arrLookup(201) = 159 arrLookup(202) = 163 arrLookup(203) = 165 arrLookup(204) = 178 arrLookup(205) = 176 arrLookup(206) = 180 arrLookup(207) = 182 arrLookup(208) = 155 arrLookup(209) = 194 arrLookup(210) = 201 arrLookup(211) = 199 arrLookup(212) = 203 arrLookup(213) = 207 arrLookup(214) = 205 arrLookup(215) = 104 arrLookup(216) = 209 arrLookup(217) = 233 arrLookup(218) = 231 arrLookup(219) = 235 arrLookup(220) = 237 arrLookup(221) = 247 arrLookup(222) = 226 arrLookup(223) = 223 arrLookup(224) = 136 arrLookup(225) = 134 arrLookup(226) = 138 arrLookup(227) = 142 arrLookup(228) = 140 arrLookup(229) = 144 arrLookup(230) = 146 arrLookup(231) = 152 arrLookup(232) = 162 arrLookup(233) = 160 arrLookup(234) = 164 arrLookup(235) = 166 arrLookup(236) = 179 arrLookup(237) = 177 arrLookup(238) = 181 arrLookup(239) = 183 arrLookup(240) = 156 arrLookup(241) = 195 arrLookup(242) = 202 arrLookup(243) = 200 arrLookup(244) = 204 arrLookup(245) = 208 arrLookup(246) = 206 arrLookup(247) = 105 arrLookup(248) = 210 arrLookup(249) = 234 arrLookup(250) = 232 arrLookup(251) = 236 arrLookup(252) = 238 arrLookup(253) = 248 arrLookup(254) = 227 arrLookup(255) = 250 bFilledLookupArray1 = True End Sub Function ByteArrayToString(btArray() As Byte) As String Dim sAns As String Dim lPos As Long sAns = StrConv(btArray, vbUnicode) lPos = InStr(sAns, Chr(0)) If lPos 0 Then sAns = Left(sAns, lPos - 1) End If ByteArrayToString = sAns End Function Sub StartSW() lStartTime = timeGetTime() End Sub Function StopSW(Optional bMsgBox As Boolean = True, _ Optional vMessage As Variant, _ Optional lMinimumTimeToShow As Long = -1) As Variant Dim lTime As Long lTime = timeGetTime() - lStartTime If lTime lMinimumTimeToShow Then If IsMissing(vMessage) Then StopSW = lTime Else StopSW = lTime & " - " & vMessage End If End If If bMsgBox Then If lTime lMinimumTimeToShow Then MsgBox "Done in " & lTime & " msecs", , vMessage End If End If End Function RBS "RB Smissaert" wrote in message ... The code I posted had a flaw in that it didn't sort AaBbCc etc. With a simple byte converter this is now fixed and this carries only a very small performance penalty and it is still a lot faster than the posted bubblesorts. The strings this works on may be small, but if you use it as a worksheet UDF and it works on a lot of cells then speed could be important. I added a timing test, so you can see the difference. Option Explicit Private lStartTime As Long Private Declare Function timeGetTime Lib "winmm.dll" () As Long Private arrLookup(0 To 255) As Byte Private arrLookup2(0 To 255) As Byte Private bFilledLookupArray1 As Boolean Private bFilledLookupArray2 As Boolean Sub test() Dim i As Long Dim str As String Dim strSorted As String Dim bSortAaBb As Boolean Dim bCountingSort As Boolean Dim bUseSortCharacters As Boolean str = "ZYXWVUTSRQPONMLKJIHGFEDCBA zyxwvutsrqponmlkjihgfedcba 9876543210" If MsgBox("Use the CountingSort?", vbYesNo, "sorting string") = vbYes Then bCountingSort = True If MsgBox("Sort as AaBbCc etc.?", vbYesNo, "sorting string") = vbYes Then bSortAaBb = True End If Else If MsgBox("Use SortCharacters?", vbYesNo, "sorting string") = vbYes Then bUseSortCharacters = True End If End If StartSW If bCountingSort Then For i = 0 To 1000 strSorted = SortString(str, bSortAaBb) Next i Else If bUseSortCharacters Then For i = 0 To 1000 strSorted = SortCharacters(str) Next i Else For i = 0 To 1000 strSorted = SortString2(str) Next i End If End If StopSW MsgBox strSorted, , "sorted string" End Sub Function SortString(strString As String, Optional bSortAaBb As Boolean) As String Dim i As Long Dim btArray() As Byte Dim btArray2() As Byte btArray = strString If bSortAaBb Then If bFilledLookupArray1 = False Then FillLookupArray1 End If For i = 0 To UBound(btArray) Step 2 btArray(i) = arrLookup(btArray(i)) Next i End If btArray2 = CountingSortByte1D(btArray) If bSortAaBb Then If bFilledLookupArray2 = False Then FillLookupArray2 End If For i = 0 To UBound(btArray2) btArray2(i) = arrLookup2(btArray2(i)) Next i End If SortString = ByteArrayToString(btArray2) End Function Function SortString2(ByVal strIn) As String Dim i As Long Dim j As Long Dim s1 As String Dim s2 As String For i = 1 To (Len(strIn) - 1) For j = (i + 1) To Len(strIn) s1 = Mid$(strIn, i, 1) s2 = Mid$(strIn, j, 1) If StrComp(s1, s2, vbTextCompare) = 1 Then Mid$(strIn, i, 1) = s2 Mid$(strIn, j, 1) = s1 End If Next j Next i SortString2 = strIn End Function Function SortCharacters(ByVal S As String) As String Dim X As Long Dim Z As Long Dim Cnt As Long ReDim C(1 To Len(S)) As Long For X = 1 To Len(S) For Z = 1 To Len(S) If Mid(S, Z, 1) <= Mid(S, X, 1) Then C(X) = C(X) + 1 Next Next SortCharacters = String(Len(S), Chr$(1)) For X = 1 To Len(S) Mid(SortCharacters, C(X), 1) = Mid(S, X, 1) Next For X = Len(S) - 1 To 1 Step -1 If Mid(SortCharacters, X, 1) = Chr$(1) Then Mid(SortCharacters, X, 1) = Mid(SortCharacters, X + 1, 1) End If Next End Function Sub FillLookupArray1() arrLookup(0) = 255 arrLookup(1) = 11 arrLookup(2) = 12 arrLookup(3) = 13 arrLookup(4) = 14 arrLookup(5) = 15 arrLookup(6) = 16 arrLookup(7) = 17 arrLookup(8) = 18 arrLookup(9) = 49 arrLookup(10) = 50 arrLookup(11) = 51 arrLookup(12) = 52 arrLookup(13) = 53 arrLookup(14) = 19 arrLookup(15) = 20 arrLookup(16) = 21 arrLookup(17) = 22 arrLookup(18) = 23 arrLookup(19) = 24 arrLookup(20) = 25 arrLookup(21) = 26 arrLookup(22) = 27 arrLookup(23) = 28 arrLookup(24) = 29 arrLookup(25) = 30 arrLookup(26) = 31 arrLookup(27) = 32 arrLookup(28) = 33 arrLookup(29) = 34 arrLookup(30) = 35 arrLookup(31) = 36 arrLookup(32) = 47 arrLookup(33) = 54 arrLookup(34) = 55 arrLookup(35) = 56 arrLookup(36) = 57 arrLookup(37) = 58 arrLookup(38) = 59 arrLookup(39) = 10 arrLookup(40) = 60 arrLookup(41) = 61 arrLookup(42) = 62 arrLookup(43) = 97 arrLookup(44) = 63 arrLookup(45) = 43 arrLookup(46) = 64 arrLookup(47) = 65 arrLookup(48) = 0 arrLookup(49) = 1 arrLookup(50) = 2 arrLookup(51) = 3 arrLookup(52) = 4 arrLookup(53) = 5 arrLookup(54) = 6 arrLookup(55) = 7 arrLookup(56) = 8 arrLookup(57) = 9 arrLookup(58) = 66 arrLookup(59) = 67 arrLookup(60) = 98 arrLookup(61) = 99 arrLookup(62) = 100 arrLookup(63) = 68 arrLookup(64) = 69 arrLookup(65) = 130 arrLookup(66) = 147 arrLookup(67) = 149 arrLookup(68) = 153 arrLookup(69) = 157 arrLookup(70) = 167 arrLookup(71) = 170 arrLookup(72) = 172 arrLookup(73) = 174 arrLookup(74) = 184 arrLookup(75) = 186 arrLookup(76) = 188 arrLookup(77) = 190 arrLookup(78) = 192 arrLookup(79) = 196 arrLookup(80) = 213 arrLookup(81) = 215 arrLookup(82) = 217 arrLookup(83) = 219 arrLookup(84) = 224 arrLookup(85) = 229 arrLookup(86) = 239 arrLookup(87) = 241 arrLookup(88) = 243 arrLookup(89) = 245 arrLookup(90) = 251 arrLookup(91) = 70 arrLookup(92) = 71 arrLookup(93) = 72 arrLookup(94) = 73 arrLookup(95) = 75 arrLookup(96) = 76 arrLookup(97) = 131 arrLookup(98) = 148 arrLookup(99) = 150 arrLookup(100) = 154 arrLookup(101) = 158 arrLookup(102) = 168 arrLookup(103) = 171 arrLookup(104) = 173 arrLookup(105) = 175 arrLookup(106) = 185 arrLookup(107) = 187 arrLookup(108) = 189 arrLookup(109) = 191 arrLookup(110) = 193 arrLookup(111) = 197 arrLookup(112) = 214 arrLookup(113) = 216 arrLookup(114) = 218 arrLookup(115) = 220 arrLookup(116) = 225 arrLookup(117) = 230 arrLookup(118) = 240 arrLookup(119) = 242 arrLookup(120) = 244 arrLookup(121) = 246 arrLookup(122) = 252 arrLookup(123) = 77 arrLookup(124) = 78 arrLookup(125) = 79 arrLookup(126) = 80 arrLookup(127) = 37 arrLookup(128) = 123 arrLookup(129) = 38 arrLookup(130) = 91 arrLookup(131) = 169 arrLookup(132) = 94 arrLookup(133) = 121 arrLookup(134) = 118 arrLookup(135) = 119 arrLookup(136) = 74 arrLookup(137) = 122 arrLookup(138) = 221 arrLookup(139) = 95 arrLookup(140) = 211 arrLookup(141) = 39 arrLookup(142) = 253 arrLookup(143) = 40 arrLookup(144) = 41 arrLookup(145) = 89 arrLookup(146) = 90 arrLookup(147) = 92 arrLookup(148) = 93 arrLookup(149) = 120 arrLookup(150) = 45 arrLookup(151) = 46 arrLookup(152) = 88 arrLookup(153) = 228 arrLookup(154) = 222 arrLookup(155) = 96 arrLookup(156) = 212 arrLookup(157) = 42 arrLookup(158) = 254 arrLookup(159) = 249 arrLookup(160) = 48 arrLookup(161) = 81 arrLookup(162) = 106 arrLookup(163) = 107 arrLookup(164) = 108 arrLookup(165) = 109 arrLookup(166) = 82 arrLookup(167) = 110 arrLookup(168) = 83 arrLookup(169) = 111 arrLookup(170) = 132 arrLookup(171) = 102 arrLookup(172) = 112 arrLookup(173) = 44 arrLookup(174) = 113 arrLookup(175) = 84 arrLookup(176) = 114 arrLookup(177) = 101 arrLookup(178) = 128 arrLookup(179) = 129 arrLookup(180) = 85 arrLookup(181) = 115 arrLookup(182) = 116 arrLookup(183) = 117 arrLookup(184) = 86 arrLookup(185) = 127 arrLookup(186) = 198 arrLookup(187) = 103 arrLookup(188) = 124 arrLookup(189) = 125 arrLookup(190) = 126 arrLookup(191) = 87 arrLookup(192) = 135 arrLookup(193) = 133 arrLookup(194) = 137 arrLookup(195) = 141 arrLookup(196) = 139 arrLookup(197) = 143 arrLookup(198) = 145 arrLookup(199) = 151 arrLookup(200) = 161 arrLookup(201) = 159 arrLookup(202) = 163 arrLookup(203) = 165 arrLookup(204) = 178 arrLookup(205) = 176 arrLookup(206) = 180 arrLookup(207) = 182 arrLookup(208) = 155 arrLookup(209) = 194 arrLookup(210) = 201 arrLookup(211) = 199 arrLookup(212) = 203 arrLookup(213) = 207 arrLookup(214) = 205 arrLookup(215) = 104 arrLookup(216) = 209 arrLookup(217) = 233 arrLookup(218) = 231 arrLookup(219) = 235 arrLookup(220) = 237 arrLookup(221) = 247 arrLookup(222) = 226 arrLookup(223) = 223 arrLookup(224) = 136 arrLookup(225) = 134 arrLookup(226) = 138 arrLookup(227) = 142 arrLookup(228) = 140 arrLookup(229) = 144 arrLookup(230) = 146 arrLookup(231) = 152 arrLookup(232) = 162 arrLookup(233) = 160 arrLookup(234) = 164 arrLookup(235) = 166 arrLookup(236) = 179 arrLookup(237) = 177 arrLookup(238) = 181 arrLookup(239) = 183 arrLookup(240) = 156 arrLookup(241) = 195 arrLookup(242) = 202 arrLookup(243) = 200 arrLookup(244) = 204 arrLookup(245) = 208 arrLookup(246) = 206 arrLookup(247) = 105 arrLookup(248) = 210 arrLookup(249) = 234 arrLookup(250) = 232 arrLookup(251) = 236 arrLookup(252) = 238 arrLookup(253) = 248 arrLookup(254) = 227 arrLookup(255) = 250 bFilledLookupArray1 = True End Sub Sub FillLookupArray2() arrLookup2(0) = 48 arrLookup2(1) = 49 arrLookup2(2) = 50 arrLookup2(3) = 51 arrLookup2(4) = 52 arrLookup2(5) = 53 arrLookup2(6) = 54 arrLookup2(7) = 55 arrLookup2(8) = 56 arrLookup2(9) = 57 arrLookup2(10) = 39 arrLookup2(11) = 1 arrLookup2(12) = 2 arrLookup2(13) = 3 arrLookup2(14) = 4 arrLookup2(15) = 5 arrLookup2(16) = 6 arrLookup2(17) = 7 arrLookup2(18) = 8 arrLookup2(19) = 14 arrLookup2(20) = 15 arrLookup2(21) = 16 arrLookup2(22) = 17 arrLookup2(23) = 18 arrLookup2(24) = 19 arrLookup2(25) = 20 arrLookup2(26) = 21 arrLookup2(27) = 22 arrLookup2(28) = 23 arrLookup2(29) = 24 arrLookup2(30) = 25 arrLookup2(31) = 26 arrLookup2(32) = 27 arrLookup2(33) = 28 arrLookup2(34) = 29 arrLookup2(35) = 30 arrLookup2(36) = 31 arrLookup2(37) = 127 arrLookup2(38) = 129 arrLookup2(39) = 141 arrLookup2(40) = 143 arrLookup2(41) = 144 arrLookup2(42) = 157 arrLookup2(43) = 45 arrLookup2(44) = 173 arrLookup2(45) = 150 arrLookup2(46) = 151 arrLookup2(47) = 32 arrLookup2(48) = 160 arrLookup2(49) = 9 arrLookup2(50) = 10 arrLookup2(51) = 11 arrLookup2(52) = 12 arrLookup2(53) = 13 arrLookup2(54) = 33 arrLookup2(55) = 34 arrLookup2(56) = 35 arrLookup2(57) = 36 arrLookup2(58) = 37 arrLookup2(59) = 38 arrLookup2(60) = 40 arrLookup2(61) = 41 arrLookup2(62) = 42 arrLookup2(63) = 44 arrLookup2(64) = 46 arrLookup2(65) = 47 arrLookup2(66) = 58 arrLookup2(67) = 59 arrLookup2(68) = 63 arrLookup2(69) = 64 arrLookup2(70) = 91 arrLookup2(71) = 92 arrLookup2(72) = 93 arrLookup2(73) = 94 arrLookup2(74) = 136 arrLookup2(75) = 95 arrLookup2(76) = 96 arrLookup2(77) = 123 arrLookup2(78) = 124 arrLookup2(79) = 125 arrLookup2(80) = 126 arrLookup2(81) = 161 arrLookup2(82) = 166 arrLookup2(83) = 168 arrLookup2(84) = 175 arrLookup2(85) = 180 arrLookup2(86) = 184 arrLookup2(87) = 191 arrLookup2(88) = 152 arrLookup2(89) = 145 arrLookup2(90) = 146 arrLookup2(91) = 130 arrLookup2(92) = 147 arrLookup2(93) = 148 arrLookup2(94) = 132 arrLookup2(95) = 139 arrLookup2(96) = 155 arrLookup2(97) = 43 arrLookup2(98) = 60 arrLookup2(99) = 61 arrLookup2(100) = 62 arrLookup2(101) = 177 arrLookup2(102) = 171 arrLookup2(103) = 187 arrLookup2(104) = 215 arrLookup2(105) = 247 arrLookup2(106) = 162 arrLookup2(107) = 163 arrLookup2(108) = 164 arrLookup2(109) = 165 arrLookup2(110) = 167 arrLookup2(111) = 169 arrLookup2(112) = 172 arrLookup2(113) = 174 arrLookup2(114) = 176 arrLookup2(115) = 181 arrLookup2(116) = 182 arrLookup2(117) = 183 arrLookup2(118) = 134 arrLookup2(119) = 135 arrLookup2(120) = 149 arrLookup2(121) = 133 arrLookup2(122) = 137 arrLookup2(123) = 128 arrLookup2(124) = 188 arrLookup2(125) = 189 arrLookup2(126) = 190 arrLookup2(127) = 185 arrLookup2(128) = 178 arrLookup2(129) = 179 arrLookup2(130) = 65 arrLookup2(131) = 97 arrLookup2(132) = 170 arrLookup2(133) = 193 arrLookup2(134) = 225 arrLookup2(135) = 192 arrLookup2(136) = 224 arrLookup2(137) = 194 arrLookup2(138) = 226 arrLookup2(139) = 196 arrLookup2(140) = 228 arrLookup2(141) = 195 arrLookup2(142) = 227 arrLookup2(143) = 197 arrLookup2(144) = 229 arrLookup2(145) = 198 arrLookup2(146) = 230 arrLookup2(147) = 66 arrLookup2(148) = 98 arrLookup2(149) = 67 arrLookup2(150) = 99 arrLookup2(151) = 199 arrLookup2(152) = 231 arrLookup2(153) = 68 arrLookup2(154) = 100 arrLookup2(155) = 208 arrLookup2(156) = 240 arrLookup2(157) = 69 arrLookup2(158) = 101 arrLookup2(159) = 201 arrLookup2(160) = 233 arrLookup2(161) = 200 arrLookup2(162) = 232 arrLookup2(163) = 202 arrLookup2(164) = 234 arrLookup2(165) = 203 arrLookup2(166) = 235 arrLookup2(167) = 70 arrLookup2(168) = 102 arrLookup2(169) = 131 arrLookup2(170) = 71 arrLookup2(171) = 103 arrLookup2(172) = 72 arrLookup2(173) = 104 arrLookup2(174) = 73 arrLookup2(175) = 105 arrLookup2(176) = 205 arrLookup2(177) = 237 arrLookup2(178) = 204 arrLookup2(179) = 236 arrLookup2(180) = 206 arrLookup2(181) = 238 arrLookup2(182) = 207 arrLookup2(183) = 239 arrLookup2(184) = 74 arrLookup2(185) = 106 arrLookup2(186) = 75 arrLookup2(187) = 107 arrLookup2(188) = 76 arrLookup2(189) = 108 arrLookup2(190) = 77 arrLookup2(191) = 109 arrLookup2(192) = 78 arrLookup2(193) = 110 arrLookup2(194) = 209 arrLookup2(195) = 241 arrLookup2(196) = 79 arrLookup2(197) = 111 arrLookup2(198) = 186 arrLookup2(199) = 211 arrLookup2(200) = 243 arrLookup2(201) = 210 arrLookup2(202) = 242 arrLookup2(203) = 212 arrLookup2(204) = 244 arrLookup2(205) = 214 arrLookup2(206) = 246 arrLookup2(207) = 213 arrLookup2(208) = 245 arrLookup2(209) = 216 arrLookup2(210) = 248 arrLookup2(211) = 140 arrLookup2(212) = 156 arrLookup2(213) = 80 arrLookup2(214) = 112 arrLookup2(215) = 81 arrLookup2(216) = 113 arrLookup2(217) = 82 arrLookup2(218) = 114 arrLookup2(219) = 83 arrLookup2(220) = 115 arrLookup2(221) = 138 arrLookup2(222) = 154 arrLookup2(223) = 223 arrLookup2(224) = 84 arrLookup2(225) = 116 arrLookup2(226) = 222 arrLookup2(227) = 254 arrLookup2(228) = 153 arrLookup2(229) = 85 arrLookup2(230) = 117 arrLookup2(231) = 218 arrLookup2(232) = 250 arrLookup2(233) = 217 arrLookup2(234) = 249 arrLookup2(235) = 219 arrLookup2(236) = 251 arrLookup2(237) = 220 arrLookup2(238) = 252 arrLookup2(239) = 86 arrLookup2(240) = 118 arrLookup2(241) = 87 arrLookup2(242) = 119 arrLookup2(243) = 88 arrLookup2(244) = 120 arrLookup2(245) = 89 arrLookup2(246) = 121 arrLookup2(247) = 221 arrLookup2(248) = 253 arrLookup2(249) = 159 arrLookup2(250) = 255 arrLookup2(251) = 90 arrLookup2(252) = 122 arrLookup2(253) = 142 arrLookup2(254) = 158 arrLookup2(255) = 0 bFilledLookupArray2 = True End Sub Function ByteArrayToString(btArray() As Byte) As String Dim sAns As String Dim lPos As Long sAns = StrConv(btArray, vbUnicode) lPos = InStr(sAns, Chr(0)) If lPos 0 Then sAns = Left(sAns, lPos - 1) End If ByteArrayToString = sAns End Function Function CountingSortByte1D(arrByte() As Byte) As Byte() Dim i As Long Dim LB As Long Dim UB As Long Dim arrCount() As Long Dim arrByteSorted() As Byte Dim lThisCount As Long Dim lNext_Offset As Long LB = LBound(arrByte) UB = UBound(arrByte) 'Create the Counts array ReDim arrCount(0 To 255) 'create the sorted return array ReDim arrByteSorted(LB To UB \ 2) As Byte 'Count the items For i = LB To UB Step 2 arrCount(arrByte(i)) = arrCount(arrByte(i)) + 1 Next i 'Convert the arrCount into offsets lNext_Offset = LB For i = 0 To 255 lThisCount = arrCount(i) arrCount(i) = lNext_Offset lNext_Offset = lNext_Offset + lThisCount Next i 'Place the items in the sorted array For i = LB To UB Step 2 arrByteSorted(arrCount(arrByte(i))) = arrByte(i) arrCount(arrByte(i)) = arrCount(arrByte(i)) + 1 Next i CountingSortByte1D = arrByteSorted End Function Sub StartSW() lStartTime = timeGetTime() End Sub Function StopSW(Optional bMsgBox As Boolean = True, _ Optional vMessage As Variant, _ Optional lMinimumTimeToShow As Long = -1) As Variant Dim lTime As Long lTime = timeGetTime() - lStartTime If lTime lMinimumTimeToShow Then If IsMissing(vMessage) Then StopSW = lTime Else StopSW = lTime & " - " & vMessage End If End If If bMsgBox Then If lTime lMinimumTimeToShow Then MsgBox "Done in " & lTime & " msecs", , vMessage End If End If End Function RBS "John" wrote in message ... Say you have a string="14386ah" Is there a excel vba function that will sort the string? Thanks JOhn |
All times are GMT +1. The time now is 02:46 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com