OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 19-12-2007, 14:51
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default [useful code] sortDelimitedText

Here's a function that sorts any amount of delimited text (the limit is only the RAM :-) very very quickly

Usage: sortedString = sortDelimitedText( someString, vbCrLf, bKeepDupes:=False, bAscending:=False, bCaseSensitive:=True)

All parameters except the text to sort are optional, their defaults are specified in the function header and are visible in the code-autocomplete tooltips (invokable also by Ctrl-I)
Code:
Function sortDelimitedText _
               (text$, _
                Optional Delim$ = vbCr, _
                Optional ByVal bKeepDupes As Boolean = False, _
                Optional ByVal bAscending As Boolean = True, _
                Optional ByVal bCaseSensitive As Boolean = False) _
   As String
   
   Dim var As Variant, sorted As Collection
   Dim L&, LDelim&, LText&, s$, k$, Direction&, txtCmp&
   Dim a&, b&, C&, rel&, collCnt&
   
   Set sorted = New Collection
   
   Direction = IIf(bAscending, 1, -1)
   txtCmp = IIf(bCaseSensitive, vbBinaryCompare, vbTextCompare)
   LDelim = Len(Delim)
   On Error Resume Next 'ignore collection VB error on adding a dupe
   
   For Each var In Split(text, Delim)
      s = CStr(var)
      If bKeepDupes Then
         k = (collCnt + 1)
      Else
         k = s
         Err.Clear
      End If
      
      a = 1: b = collCnt: C = 0: rel = 0
      Do While b - a >= 0
         C = (a + b) \ 2: rel = StrComp(s, sorted(C), txtCmp) * Direction
         Select Case rel
            Case -1: If C = a Then Exit Do Else b = C
            Case 0:  Exit Do
            Case 1:  If b = a Then Exit Do Else If a = C Then a = b Else a = C
         End Select
      Loop
      If C = 0 Then sorted.Add s, k Else If rel = -1 Then sorted.Add s, k, C Else sorted.Add s, k, , C
      
      If bKeepDupes Then
         collCnt = collCnt + 1
      ElseIf Err.Number = 0 Then
         LText = LText + Len(s) + LDelim
         collCnt = collCnt + 1
      End If
   Next
   
   If bKeepDupes Then LText = Len(text)
   If LText = 0 Then Exit Function
   sortDelimitedText = Space$(LText)
   L = 1
   
   For Each var In sorted
     Mid$(sortDelimitedText, L) = var: L = L + Len(var)
     If L >= LText Then Exit For 'last delim is unneeded
     Mid$(sortDelimitedText, L) = Delim: L = L + LDelim
   Next
End Function
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump


All times are GMT -5. The time now is 07:31.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com