- Option Explicit
-
-
- '**********************************************************************************
- ' FONCTION DE TRIE ALPHABETIQUE D'UN TABLEAU DE CHAINES DE CARACTERES *
- ' ------------------------------------------------------------------- *
- ' *
- ' Auteur : S. Alexandre *
- ' Adresse : Paris (France) *
- ' *
- ' Date de création : 24/06/2003 *
- ' Modifier : 08/02/2004 *
- ' Language : Visual Basic 6 *
- ' *
- ' ------------------------------------------------------------------ *
- ' *
- ' Paramétre d'entrée : *
- ' tab_trie() = tableau a trier *
- ' *
- ' Paramétre en sortie : *
- ' Sorted_TabString = true <le trier c'est effectuer sans *
- ' probléme. Le tableau a été modifier en conséquence> *
- ' Sorted_TabString = false <Une erreur c'est produite. le *
- ' tableau n'a pas été modifier.> *
- ' *
- '**********************************************************************************
- Public Function Sorted_TabString(tab_trie() As String) As Boolean
- Dim l() As String
- Dim s1 As String, s2 As String
- Dim a As Long, id As Long, c As Long, d As Long
- On Error GoTo err_quit
- ReDim l(0)
- l(0) = tab_trie(0)
- For a = 1 To UBound(tab_trie(), 1)
- id = 0
- c = 1
- Do While id <= UBound(l(), 1)
- s1 = LCase(Mid(Trim(tab_trie(a)), c, 1))
- s2 = LCase(Mid(Trim(l(id)), c, 1))
- If s1 < s2 Then
- Exit Do
- ElseIf s1 = s2 Then
- c = c + 1
- If c > Len(Trim(tab_trie(a))) + 1 Or c > Len(Trim(l(id))) + 1 Then
- Exit Do
- end if
- Else
- c = 1
- id = id + 1
- End If
- Loop
- ReDim Preserve l(a)
- For d = UBound(l(), 1) To id + 1 Step -1
- l(d) = l(d - 1)
- Next d
- l(id) = tab_trie(a)
- Next a
- tab_trie() = l()
- Sorted_TabString = True
- Exit Function
- err_quit:
- Sorted_TabString = False
- End Function
-
Option Explicit
'**********************************************************************************
' FONCTION DE TRIE ALPHABETIQUE D'UN TABLEAU DE CHAINES DE CARACTERES *
' ------------------------------------------------------------------- *
' *
' Auteur : S. Alexandre *
' Adresse : Paris (France) *
' *
' Date de création : 24/06/2003 *
' Modifier : 08/02/2004 *
' Language : Visual Basic 6 *
' *
' ------------------------------------------------------------------ *
' *
' Paramétre d'entrée : *
' tab_trie() = tableau a trier *
' *
' Paramétre en sortie : *
' Sorted_TabString = true <le trier c'est effectuer sans *
' probléme. Le tableau a été modifier en conséquence> *
' Sorted_TabString = false <Une erreur c'est produite. le *
' tableau n'a pas été modifier.> *
' *
'**********************************************************************************
Public Function Sorted_TabString(tab_trie() As String) As Boolean
Dim l() As String
Dim s1 As String, s2 As String
Dim a As Long, id As Long, c As Long, d As Long
On Error GoTo err_quit
ReDim l(0)
l(0) = tab_trie(0)
For a = 1 To UBound(tab_trie(), 1)
id = 0
c = 1
Do While id <= UBound(l(), 1)
s1 = LCase(Mid(Trim(tab_trie(a)), c, 1))
s2 = LCase(Mid(Trim(l(id)), c, 1))
If s1 < s2 Then
Exit Do
ElseIf s1 = s2 Then
c = c + 1
If c > Len(Trim(tab_trie(a))) + 1 Or c > Len(Trim(l(id))) + 1 Then
Exit Do
end if
Else
c = 1
id = id + 1
End If
Loop
ReDim Preserve l(a)
For d = UBound(l(), 1) To id + 1 Step -1
l(d) = l(d - 1)
Next d
l(id) = tab_trie(a)
Next a
tab_trie() = l()
Sorted_TabString = True
Exit Function
err_quit:
Sorted_TabString = False
End Function