Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sorting Names in an Array
Hi all, I'm trying to sort in ascending alphabet, names in an array. Here is what I've done. It works well for the first letter, but not for the following letters. So any help will be greatly appreciated! 'Function which transforms letters into figures: Public Function Letter(Nom As Variant, Position As Integer) As Long If UCase(Mid(CStr(Nom), Position, 1)) = "A" Then Letter = 1 If UCase(Mid(CStr(Nom), Position, 1)) = "B" Then Letter = 2 If UCase(Mid(CStr(Nom), Position, 1)) = "C" Then Letter = 3 If UCase(Mid(CStr(Nom), Position, 1)) = "D" Then Letter = 4 If UCase(Mid(CStr(Nom), Position, 1)) = "E" Then Letter = 5 If UCase(Mid(CStr(Nom), Position, 1)) = "F" Then Letter = 6 If UCase(Mid(CStr(Nom), Position, 1)) = "G" Then Letter = 7 If UCase(Mid(CStr(Nom), Position, 1)) = "H" Then Letter = 8 If UCase(Mid(CStr(Nom), Position, 1)) = "I" Then Letter = 9 If UCase(Mid(CStr(Nom), Position, 1)) = "J" Then Letter = 10 If UCase(Mid(CStr(Nom), Position, 1)) = "K" Then Letter = 11 If UCase(Mid(CStr(Nom), Position, 1)) = "L" Then Letter = 12 If UCase(Mid(CStr(Nom), Position, 1)) = "M" Then Letter = 13 If UCase(Mid(CStr(Nom), Position, 1)) = "N" Then Letter = 14 If UCase(Mid(CStr(Nom), Position, 1)) = "O" Then Letter = 15 If UCase(Mid(CStr(Nom), Position, 1)) = "P" Then Letter = 16 If UCase(Mid(CStr(Nom), Position, 1)) = "Q" Then Letter = 17 If UCase(Mid(CStr(Nom), Position, 1)) = "R" Then Letter = 18 If UCase(Mid(CStr(Nom), Position, 1)) = "S" Then Letter = 19 If UCase(Mid(CStr(Nom), Position, 1)) = "T" Then Letter = 20 If UCase(Mid(CStr(Nom), Position, 1)) = "U" Then Letter = 21 If UCase(Mid(CStr(Nom), Position, 1)) = "V" Then Letter = 22 If UCase(Mid(CStr(Nom), Position, 1)) = "W" Then Letter = 23 If UCase(Mid(CStr(Nom), Position, 1)) = "X" Then Letter = 24 If UCase(Mid(CStr(Nom), Position, 1)) = "Y" Then Letter = 25 If UCase(Mid(CStr(Nom), Position, 1)) = "Z" Then Letter = 26 End Function '========================================== 'Here is the sorting procedure : Private TempCode As Variant Private TempNom As Variant Private TempDate As Variant Private TempOpen As Variant Private TempHigh As Variant Private TempLow As Variant Private TempClose As Variant Private TempVolume As Variant Private LetterMin As Integer Private CodeIndex As Long Private LastSameCode As Long Private StartCode As Long Private FirstScan As Boolean Private NewSymbol As Boolean Private CodeLetterMin As Variant Private NomLetterMin As Variant Private DateLetterMin As Variant Private OpenLetterMin As Variant Private HighLetterMin As Variant Private LowLetterMin As Variant Private CloseLetterMin As Variant Private VolumeLetterMin As Variant Private Tn As Integer 'Compteur de la place de la lettre Private ZArr As Long 'Compteur de ArrFusion Private Zi As Integer 'Compteur d'index Public SortingProc() 'It Sorts the array ArrFusionClean(): LastRowArrFusion = UBound(ArrFusionClean, 1) StartCode = 1 LastSameCode = LastRowArrFusion Tn = 1 'Position de la lettre dans le code FirstScan = True NewSymbol = True FindLetter: For ZArr = StartCode To LastSameCode 'Initialisation de StartCode pour le prochain code : LetterMin = Letter(ArrFusionClean(ZArr, 1), Tn) CodeIndex = ZArr 'Index 'Searching the 'smallest' letter : For Zi = ZArr + 1 To LastSameCode 'For Zi = Zarr +1 If Letter(ArrFusionClean(Zi, 1), Tn) < LetterMin Then 'Tz 'Saving the 'smallest' letter : LetterMin = Letter(ArrFusionClean(Zi, 1), Tn) CodeIndex = Zi 'Index CodeLetterMin = ArrFusionClean(Zi, 1) NomLetterMin = ArrFusionClean(Zi, 2) DateLetterMin = ArrFusionClean(Zi, 3) OpenLetterMin = ArrFusionClean(Zi, 4) HighLetterMin = ArrFusionClean(Zi, 5) LowLetterMin = ArrFusionClean(Zi, 6) CloseLetterMin = ArrFusionClean(Zi, 7) VolumeLetterMin = ArrFusionClean(Zi, 8) End If Next Zi 'Swapinf Datas in an array : If LetterMin < Letter(ArrFusionClean(ZArr, 1), Tn) Then TempCode = ArrFusionClean(ZArr, 1) ArrFusionClean(ZArr, 1) = CodeLetterMin ArrFusionClean(CodeIndex, 1) = TempCode TempNom = ArrFusionClean(ZArr, 2) ArrFusionClean(ZArr, 2) = NomLetterMin ArrFusionClean(CodeIndex, 2) = TempNom TempDate = ArrFusionClean(ZArr, 3) ArrFusionClean(ZArr, 3) = DateLetterMin ArrFusionClean(CodeIndex, 3) = TempDate TempOpen = ArrFusionClean(ZArr, 4) ArrFusionClean(ZArr, 4) = OpenLetterMin ArrFusionClean(CodeIndex, 4) = TempOpen TempHigh = ArrFusionClean(ZArr, 5) ArrFusionClean(ZArr, 5) = HighLetterMin ArrFusionClean(CodeIndex, 5) = TempHigh TempLow = ArrFusionClean(ZArr, 6) ArrFusionClean(ZArr, 6) = LowLetterMin ArrFusionClean(CodeIndex, 6) = TempLow TempClose = ArrFusionClean(ZArr, 7) ArrFusionClean(ZArr, 7) = CloseLetterMin ArrFusionClean(CodeIndex, 7) = TempClose TempVolume = ArrFusionClean(ZArr, 8) ArrFusionClean(ZArr, 8) = VolumeLetterMin ArrFusionClean(CodeIndex, 8) = TempVolume End If Next ZArr If FirstScan = True Then StartCode = 1 LastSameCode = 1 ' FirstScan = False ' First Scan is done Debug.Print "Tri par des codes par ordre alphabétique de la 1ère lettre : " For ZArr = 1 To LastRowArrFusion Debug.Print ZArr & " , " & ArrFusionClean(ZArr, 1) & " , " & ArrFusionClean(ZArr, 2) & " , " & ArrFusionClean(ZArr, 3) & " , " & ArrFusionClean(ZArr, 4) & " , " & ArrFusionClean(ZArr, 5) & " , " & ArrFusionClean(ZArr, 6) & " , " & ArrFusionClean(ZArr, 7) & " , " & ArrFusionClean(ZArr, 8) Next ZArr Else If NewSymbol = True Then 'Scanning a new name : Tn = 1 StartCode = LastSameCode + 1 ' NewSymbol = False Else If Tn < 4 Then 'Scanning all the letters in a name : Tn = Tn + 1 End If End If End If If StartCode < LastRowArrFusion And NewSymbol = True Then For ZArr = StartCode To LastRowArrFusion If Letter(ArrFusionClean(ZArr + 1, 1), Tn) = Letter(ArrFusionClean(ZArr, 1), Tn) Then LastSameCode = LastSameCode + 1 Else Exit For End If Next ZArr If FirstScan = True Then FirstScan = False NewSymbol = True Else NewSymbol = False End If If LastSameCode + StartCode - 1 <= LastRowArrFusion Then LastSameCode = LastSameCode + StartCode - 1 Else LastSameCode = LastRowArrFusion End If End If 'We Start again to FindLetter label : If StartCode < LastRowArrFusion Then GoTo FindLetter End Sub '================================ 'Many thanks for your help 'Phil *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sorting Names in an Array
If all you want to do is sort, your code seems unnecessarily
complicated because all you need to do is write code to put the data into a worksheet,sort it, then put it back into the array. Set your macro recorder whilst doing the job manually. Regards BrianB ============================================= Philippe Lhermie wrote in message ... Hi all, I'm trying to sort in ascending alphabet, names in an array. Here is what I've done. It works well for the first letter, but not for the following letters. So any help will be greatly appreciated! 'Function which transforms letters into figures: Public Function Letter(Nom As Variant, Position As Integer) As Long If UCase(Mid(CStr(Nom), Position, 1)) = "A" Then Letter = 1 If UCase(Mid(CStr(Nom), Position, 1)) = "B" Then Letter = 2 If UCase(Mid(CStr(Nom), Position, 1)) = "C" Then Letter = 3 If UCase(Mid(CStr(Nom), Position, 1)) = "D" Then Letter = 4 If UCase(Mid(CStr(Nom), Position, 1)) = "E" Then Letter = 5 If UCase(Mid(CStr(Nom), Position, 1)) = "F" Then Letter = 6 If UCase(Mid(CStr(Nom), Position, 1)) = "G" Then Letter = 7 If UCase(Mid(CStr(Nom), Position, 1)) = "H" Then Letter = 8 If UCase(Mid(CStr(Nom), Position, 1)) = "I" Then Letter = 9 If UCase(Mid(CStr(Nom), Position, 1)) = "J" Then Letter = 10 If UCase(Mid(CStr(Nom), Position, 1)) = "K" Then Letter = 11 If UCase(Mid(CStr(Nom), Position, 1)) = "L" Then Letter = 12 If UCase(Mid(CStr(Nom), Position, 1)) = "M" Then Letter = 13 If UCase(Mid(CStr(Nom), Position, 1)) = "N" Then Letter = 14 If UCase(Mid(CStr(Nom), Position, 1)) = "O" Then Letter = 15 If UCase(Mid(CStr(Nom), Position, 1)) = "P" Then Letter = 16 If UCase(Mid(CStr(Nom), Position, 1)) = "Q" Then Letter = 17 If UCase(Mid(CStr(Nom), Position, 1)) = "R" Then Letter = 18 If UCase(Mid(CStr(Nom), Position, 1)) = "S" Then Letter = 19 If UCase(Mid(CStr(Nom), Position, 1)) = "T" Then Letter = 20 If UCase(Mid(CStr(Nom), Position, 1)) = "U" Then Letter = 21 If UCase(Mid(CStr(Nom), Position, 1)) = "V" Then Letter = 22 If UCase(Mid(CStr(Nom), Position, 1)) = "W" Then Letter = 23 If UCase(Mid(CStr(Nom), Position, 1)) = "X" Then Letter = 24 If UCase(Mid(CStr(Nom), Position, 1)) = "Y" Then Letter = 25 If UCase(Mid(CStr(Nom), Position, 1)) = "Z" Then Letter = 26 End Function '========================================== 'Here is the sorting procedure : Private TempCode As Variant Private TempNom As Variant Private TempDate As Variant Private TempOpen As Variant Private TempHigh As Variant Private TempLow As Variant Private TempClose As Variant Private TempVolume As Variant Private LetterMin As Integer Private CodeIndex As Long Private LastSameCode As Long Private StartCode As Long Private FirstScan As Boolean Private NewSymbol As Boolean Private CodeLetterMin As Variant Private NomLetterMin As Variant Private DateLetterMin As Variant Private OpenLetterMin As Variant Private HighLetterMin As Variant Private LowLetterMin As Variant Private CloseLetterMin As Variant Private VolumeLetterMin As Variant Private Tn As Integer 'Compteur de la place de la lettre Private ZArr As Long 'Compteur de ArrFusion Private Zi As Integer 'Compteur d'index Public SortingProc() 'It Sorts the array ArrFusionClean(): LastRowArrFusion = UBound(ArrFusionClean, 1) StartCode = 1 LastSameCode = LastRowArrFusion Tn = 1 'Position de la lettre dans le code FirstScan = True NewSymbol = True FindLetter: For ZArr = StartCode To LastSameCode 'Initialisation de StartCode pour le prochain code : LetterMin = Letter(ArrFusionClean(ZArr, 1), Tn) CodeIndex = ZArr 'Index 'Searching the 'smallest' letter : For Zi = ZArr + 1 To LastSameCode 'For Zi = Zarr +1 If Letter(ArrFusionClean(Zi, 1), Tn) < LetterMin Then 'Tz 'Saving the 'smallest' letter : LetterMin = Letter(ArrFusionClean(Zi, 1), Tn) CodeIndex = Zi 'Index CodeLetterMin = ArrFusionClean(Zi, 1) NomLetterMin = ArrFusionClean(Zi, 2) DateLetterMin = ArrFusionClean(Zi, 3) OpenLetterMin = ArrFusionClean(Zi, 4) HighLetterMin = ArrFusionClean(Zi, 5) LowLetterMin = ArrFusionClean(Zi, 6) CloseLetterMin = ArrFusionClean(Zi, 7) VolumeLetterMin = ArrFusionClean(Zi, 8) End If Next Zi 'Swapinf Datas in an array : If LetterMin < Letter(ArrFusionClean(ZArr, 1), Tn) Then TempCode = ArrFusionClean(ZArr, 1) ArrFusionClean(ZArr, 1) = CodeLetterMin ArrFusionClean(CodeIndex, 1) = TempCode TempNom = ArrFusionClean(ZArr, 2) ArrFusionClean(ZArr, 2) = NomLetterMin ArrFusionClean(CodeIndex, 2) = TempNom TempDate = ArrFusionClean(ZArr, 3) ArrFusionClean(ZArr, 3) = DateLetterMin ArrFusionClean(CodeIndex, 3) = TempDate TempOpen = ArrFusionClean(ZArr, 4) ArrFusionClean(ZArr, 4) = OpenLetterMin ArrFusionClean(CodeIndex, 4) = TempOpen TempHigh = ArrFusionClean(ZArr, 5) ArrFusionClean(ZArr, 5) = HighLetterMin ArrFusionClean(CodeIndex, 5) = TempHigh TempLow = ArrFusionClean(ZArr, 6) ArrFusionClean(ZArr, 6) = LowLetterMin ArrFusionClean(CodeIndex, 6) = TempLow TempClose = ArrFusionClean(ZArr, 7) ArrFusionClean(ZArr, 7) = CloseLetterMin ArrFusionClean(CodeIndex, 7) = TempClose TempVolume = ArrFusionClean(ZArr, 8) ArrFusionClean(ZArr, 8) = VolumeLetterMin ArrFusionClean(CodeIndex, 8) = TempVolume End If Next ZArr If FirstScan = True Then StartCode = 1 LastSameCode = 1 ' FirstScan = False ' First Scan is done Debug.Print "Tri par des codes par ordre alphabétique de la 1ère lettre : " For ZArr = 1 To LastRowArrFusion Debug.Print ZArr & " , " & ArrFusionClean(ZArr, 1) & " , " & ArrFusionClean(ZArr, 2) & " , " & ArrFusionClean(ZArr, 3) & " , " & ArrFusionClean(ZArr, 4) & " , " & ArrFusionClean(ZArr, 5) & " , " & ArrFusionClean(ZArr, 6) & " , " & ArrFusionClean(ZArr, 7) & " , " & ArrFusionClean(ZArr, 8) Next ZArr Else If NewSymbol = True Then 'Scanning a new name : Tn = 1 StartCode = LastSameCode + 1 ' NewSymbol = False Else If Tn < 4 Then 'Scanning all the letters in a name : Tn = Tn + 1 End If End If End If If StartCode < LastRowArrFusion And NewSymbol = True Then For ZArr = StartCode To LastRowArrFusion If Letter(ArrFusionClean(ZArr + 1, 1), Tn) = Letter(ArrFusionClean(ZArr, 1), Tn) Then LastSameCode = LastSameCode + 1 Else Exit For End If Next ZArr If FirstScan = True Then FirstScan = False NewSymbol = True Else NewSymbol = False End If If LastSameCode + StartCode - 1 <= LastRowArrFusion Then LastSameCode = LastSameCode + StartCode - 1 Else LastSameCode = LastRowArrFusion End If End If 'We Start again to FindLetter label : If StartCode < LastRowArrFusion Then GoTo FindLetter End Sub '================================ 'Many thanks for your help 'Phil *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sorting Names in an Array
Thanks Brian, for your help.
But your solution is by far the slowest. The reason I exported my Excel spreadsheet into an array is for speed, especially when you have a lot of verifications to do whith a lot of lines (20 000 lines). And I do not want to use Access. Anyway, thanks for replying. Regards, Phil *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sorting Names in an Array
Folks,
I have to more clear: I exported one spreadsheet into a 2 dimensions array for speed reason. I would like to sort lines by code names, and not sort letters into these names. For example: Jaguar,10 Ferrari,20 Mercedes,30 Februray, 40 Fest,50 The result should be: Februray, 40 Ferrari,20 Fest,50 Jaguar,10 Mercedes,30 Regards, Phil *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sorting Names in an Array
"SuperPhil" <tradingtools.free.fr wrote in message ... Folks, I have to more clear: I exported one spreadsheet into a 2 dimensions array for speed reason. I would like to sort lines by code names, and not sort letters into these names. For example: Jaguar,10 Ferrari,20 Mercedes,30 Februray, 40 Fest,50 The result should be: Februray, 40 Ferrari,20 Fest,50 Jaguar,10 Mercedes,30 Then I'd definitely suggest you use a disconnected ADO recordset see http://support.microsoft.com:80/supp...NoWebContent=1 Keith |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sorting Names in an Array
Many thanks Keith, I'm trying to use ADO and SQL I will let you know. Thanks for your tip Regards, Phil *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sorting Names in an Array
Hi all and Keith, This message as also been posted partially on microsoft.public.vb.database.ado) My Excel Workbook will be used by users on Windows 98, 2000 and XP with Excel 2000 or XP. Because my spreadSheet may contain up to 20 000 rows, I decided to use ADO for manipulating data. 1. Which library do I need to reference in the VBA Editor? I have these ones on my PC : Microsoft ActiveX Data Object 2.5 Library Microsoft ActiveX Data Object 2.6 Library Microsoft ActiveX Data Object 2.7 Library In one of my books (VBA for Excel 2002, Stephen bullen, Wrox Campus press), they recommand the 2.5 library. I Tried 2.5 and 2.7, and so far both work. 2. Which engine do you recommand? Microsoft.Jet.OLEDB.4.0 or Microsoft Excel Driver (*.xls)}? 3. I noticed one SQL query doesn't work: (I added a header to each column in row 1: CODE,NAME,DATE, etc...) SELECT *FROM [SHEET1$] works but SELECT NAME FROM [SHEET1$] does not work although CODE exists. Do you know why? Any advice is greatly appreciated. Regards, Phil Regards, Phil *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Sorting and matching rows of names with Socials with master list and eliminating the extra names | Excel Worksheet Functions | |||
XL2007 and array of sheet names? | Excel Discussion (Misc queries) | |||
Sorting names in Name box | Excel Worksheet Functions | |||
Sorting names in Name box | Excel Worksheet Functions | |||
sorting names alphabetically when names may start with numbers | Excel Discussion (Misc queries) |