Accueil > > > CLASSER PAR ORDRE ALPHABETIQUE(SIMPLE)
CLASSER PAR ORDRE ALPHABETIQUE(SIMPLE)
Information sur la source
Description
Voila-------------------> | | | | | \/ c un module
Source
'Vous etes priez de respecter ce code
'Meme si vous le trouvez incoplait
'Dite le mois puis je le rectifeai
'Moi je trouve qu'il est simple
'info-----> je ne regarde sur auqun code
'-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
'Ce triage est un triage que g inventer il donne le plus grande imporatance au premier puis apre
'Ex 1: chien
' 2: Chat
' 3: Boule
' 4: Variable
'comme Variable est le plus grand mot(composer de 8 caractere)
'le premier caractere(code decimal)de tout les mots sera multiplier par 8
'puis le 2 par 8-1 etc... puis le total sera fixé dans un varaible specifique
'au mot
'puis le mot qui a le plus petit nombre sera le premier...
'meme si il y deux fois le meme nombre la function
'classera le deuxiemeou troiseme... venu apres le mots deja enregistre
'Cela classe aussi les signe par rapport a code decimal
'Le plus c wquon peut associer des donné pour pouvoir les retrouver facilemnt
'Comme pour des fichier
'ex donné : son nom
'd1: son extension
'd2: sa date de creation
'etc....
'-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
'''''''''Script Arts
'''''''''Script Arts
'Enregistrement des variables
Public Mots(1 To 1000) As Typen1
Dim ajou(1 To 1000) As Typen1
Dim Remot(1 To 1000) As Typen2
Public Type Typen1
Donne As String
D1 As String
D2 As String
D3 As String
D4 As String
D5 As String
D6 As String
D7 As String
D8 As String
D9 As String
End Type
Public Type Typen2
Donne As String
D1 As String
D2 As String
D3 As String
D4 As String
D5 As String
D6 As String
D7 As String
D8 As String
D9 As String
nb As Byte
End Type
Public MotClasse(1 To 1000) As Typen1
Dim Maxlen As Long
'Nombredemot : Nombre de mot a trier (pas aubliger que ce soit extacte mais toujour +)
Public Function ClasseOrdeAlphabetique(ByVal Nombredemot As Long)
nbmot = 0
Maxlen = 0
'cherche le plus grand mots (en longeur)
For i = 1 To Nombredemot
If Len(Mots(i).Donne) > Maxlen Then
'si la longueur du mot encore est plus grand que la variable cela l'enregistre
Maxlen = Len(Mots(i).Donne)
End If
'cherche le nombre de mots
If Mots(i).Donne = "" Then
Exit For
Else
nbmot = nbmot + 1
End If
Next i
'Commence a chercher les mots
For mot = 1 To nbmot
cal = 0
'commence a chercher les lettre
For lettre = 1 To Len(Mots(mot).Donne)
'Mais a la puissance de sa possision son code decimal(tou reduit en minuscule )
'c apres que la difference entre la majuscule est le minuscule va ce joué
cal = cal + (Asc(Mid(UCase(Mots(mot).Donne), lettre, 1))) ^ (Maxlen - lettre + 1)
'End If
Next lettre
For lettre2 = 1 To Len(Mots(mot).Donne)
If Asc(Mid(Mots(mot).Donne, lettre2, 1)) >= 97 And Asc(Mid(Mots(mot).Donne, lettre2, 1)) <= 122 Then
'Si c une minuscule ajoute 1+maxlen - letrre
'Pareil c la premier qui vaut le + pui la deusieme etc...
cal = cal + 1 + Maxlen - lettre2
End If
Next lettre2
'enregistre le nombre trouver puis c autre variable
ajou(mot).Donne = cal
ajou(mot).D1 = Mots(mot).D1
ajou(mot).D2 = Mots(mot).D2
ajou(mot).D3 = Mots(mot).D3
ajou(mot).D4 = Mots(mot).D4
ajou(mot).D5 = Mots(mot).D5
ajou(mot).D6 = Mots(mot).D6
ajou(mot).D7 = Mots(mot).D7
ajou(mot).D8 = Mots(mot).D8
ajou(mot).D9 = Mots(mot).D9
Next mot
For k = 1 To nbmot
'initialise
tot = 1
For j = 1 To nbmot
'compare le mot(k) au motcherche(j) compare le nombre
If ajou(k).Donne <> ajou(j).Donne Then
'si il est différant
op = Len(ajou(j).Donne)
opr = Len(ajou(k).Donne)
If Val(ajou(j).Donne) < Val(ajou(k).Donne) Then
'si il est plus grand il l'augemente d'une place
tot = tot + 1
End If
End If
Next j
If Remot(tot).nb > 0 Then
'si il y adeja un mot ajoute une place(le met apres)
tot = tot + Remot(tot).nb
End If
If Remot(tot).Donne = "" Then
'si la variable est vide il enregistre
Remot(tot).Donne = Mots(k).Donne
Remot(tot).D1 = Mots(k).D1
Remot(tot).D2 = Mots(k).D2
Remot(tot).D3 = Mots(k).D3
Remot(tot).D4 = Mots(k).D4
Remot(tot).D5 = Mots(k).D5
Remot(tot).D6 = Mots(k).D6
Remot(tot).D7 = Mots(k).D7
Remot(tot).D8 = Mots(k).D8
Remot(tot).D9 = Mots(k).D9
Remot(tot).nb = 1
End If
Next k
' je pouvais le metre tou de suite mais il y avit une variable(nb)qui
'cervais a rien
For classe = 1 To nbmot
MotClasse(classe).Donne = Remot(classe).Donne
MotClasse(classe).D1 = Remot(classe).D1
MotClasse(classe).D2 = Remot(classe).D2
MotClasse(classe).D3 = Remot(classe).D3
MotClasse(classe).D4 = Remot(classe).D4
MotClasse(classe).D5 = Remot(classe).D5
MotClasse(classe).D6 = Remot(classe).D6
MotClasse(classe).D7 = Remot(classe).D7
MotClasse(classe).D8 = Remot(classe).D8
MotClasse(classe).D9 = Remot(classe).D9
Next classe
End Function
Public Function Actualise()
'Pa besoin desplication
For o = 1 To 1000
Mots(o).Donne = ""
Mots(o).D1 = ""
Mots(o).D2 = ""
Mots(o).D3 = ""
Mots(o).D4 = ""
Mots(o).D5 = ""
Mots(o).D6 = ""
Mots(o).D7 = ""
Mots(o).D8 = ""
Mots(o).D9 = ""
ajou(o).Donne = ""
ajou(o).D1 = ""
ajou(o).D2 = ""
ajou(o).D3 = ""
ajou(o).D4 = ""
ajou(o).D5 = ""
ajou(o).D6 = ""
ajou(o).D7 = ""
ajou(o).D8 = ""
ajou(o).D9 = ""
Remot(o).nb = 0
Remot(o).Donne = ""
Remot(o).D1 = ""
Remot(o).D2 = ""
Remot(o).D3 = ""
Remot(o).D4 = ""
Remot(o).D5 = ""
Remot(o).D6 = ""
Remot(o).D7 = ""
Remot(o).D8 = ""
Remot(o).D9 = ""
MotClasse(o).Donne = ""
MotClasse(o).D1 = ""
MotClasse(o).D2 = ""
MotClasse(o).D3 = ""
MotClasse(o).D4 = ""
MotClasse(o).D5 = ""
MotClasse(o).D6 = ""
MotClasse(o).D7 = ""
MotClasse(o).D8 = ""
MotClasse(o).D9 = ""
Next o
End Function
Conclusion
il est aussi dnas le zip
Sources du même auteur
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
XNA IS DEAD!XNA IS DEAD! par richardc
Depuis la semaine dernière (et grâce aux TechDays 2012), je me penche activement sur la nouvelle version de Windows, aka Windows 8. Vous me direz, il était temps puisque la première preview date de Septembre dernier.
OK. Remarquez, on n'en est qu'aux...
Cliquez pour lire la suite de l'article par richardc TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 !TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice
Speakers: Fabrice Meillon et Stanislas Quastana Cette session est basée entièrement sur celle donnée lors de la BUILD cet hiver. Il n'y a pas d'ajout d'information en rapport avec cet évènement passé. Windows 8 Server sera intégralem...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice [HTML5] AUTOUR DU W3C : NOUVEAUX STANDARDS ET WEB MOBILE (LILLE)[HTML5] AUTOUR DU W3C : NOUVEAUX STANDARDS ET WEB MOBILE (LILLE) par Gio
Je m'y prends un peu tard je sais, mais bon je suis développeur web et donc hyper fainéant ! Toujours dans le cadre des technologies émergentes, ici HTML5, parce qu'on aime HTML5 chez Wyg , nous seront présent, le vieux ( Aurélien V.) et moi, pour pr...
Cliquez pour lire la suite de l'article par Gio [WP7] DYNAMICALLY CHANGE STARTUP PAGE[WP7] DYNAMICALLY CHANGE STARTUP PAGE par KooKiz
Let's say that you want to allow the user to customize the startup page of your application. You can easily change the startup page by editing the 'NavigationPage' attribute in the manifest file. But the manifest cannot be modified once the applicatio...
Cliquez pour lire la suite de l'article par KooKiz
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|