[VBA] Savoir si n'importe quel caractère défini est plusieurs fois...

Savoir si n'importe quel caractère défini est plusieurs fois... [VBA] - VB/VBA/VBS - Programmation

Marsh Posté le 26-03-2013 à 17:29:42    

Hello à tous,
 
J'ai un dilem,
 
Je dois créer un fichier txt avec des lignes de 8 caractères de 0-9 et A-Z.
Jusque là pas de soucis...
 
Mon soucis c'est que je ne veux pas avoir plus de 3x le même caractère à la suite par exemple...
 
Genre j'ai :
"00000000", je voudrais pas l'ajouter dans mon fichier texte, idem si c'est "01234AAA" vu que le A est 3x
 
Le truc c'est que je m'en fou si c'est un A ou un 0 qui est à double, ma priorité est la rapidité d'exécution car j'ai pas mal de ligne à créer!
 
Pour le moment avec une imbrication de for j'arrive à créer ces chaines l'une après l'autre et ajouter dans le fichier, manque juste le test avant de les ajouter s'il y a plus de 3x le même caractère à suivre!
 
J'ai à disposition 8 variables avec le caractère qui va être écrit dans le fichier texte si ça peut aider!
 
Merci d'avance de votre aide, j'espère avoir été assez claire pour que quelqu'un me comprenne :P

Message cité 2 fois
Reply

Marsh Posté le 26-03-2013 à 17:29:42   

Reply

Marsh Posté le 26-03-2013 à 17:36:13    

J'imaginais un truc genre la fonction NB pour compter le nombre de caractères différent afin de dire s'il y a plus que 6 car différent c'est bon...?!


---------------
Swisscore
Reply

Marsh Posté le 26-03-2013 à 20:01:13    

Bonjour,
 
je n'ai pas la réponse  :o mais j'ai des questions  [:arantheus]  
 
Est-ce que tu peux nous en dire + sur la phase de création ? As-tu d'autres contraintes ? (On peut peut-être créer les bon strings en amont pour éviter de les tester en aval ?)
Mettre ton code pourrait aider  :jap:  
 
Sinon je ne voit pas trop comment utiliser la fonction NB :??:  Le + trivial c'est parcourir le string de 1 à 6 avec la fonction MID et tester avec strcomp("","",vbBinaryCompare).

Reply

Marsh Posté le 26-03-2013 à 22:39:10    

 
          http://smileys.sur-la-toile.com/repository/Messages/plus-un2.gif pour voir le code car cela manque de précision !
 
           Quel logiciel, quelle version ?       Pas de souci pour la rapidité tant que cela reste des variables en RAM.
           Je vois bien un truc tout con via un tableau indicé, du genre - 48 pour les chiffres & - 55 pour les lettres …
 

Reply

Marsh Posté le 27-03-2013 à 10:42:03    

swissforever a écrit :

[…] Mon soucis c'est que je ne veux pas avoir plus de 3x le même caractère à la suite par exemple...
 
      Genre j'ai :
      "00000000", je voudrais pas l'ajouter dans mon fichier texte, idem si c'est "01234AAA" vu que le A est 3x

            Avec l'exemple de "01234AAA" ce n'est donc pas plus de 3x mais plus de 2x ‼     Faudrait vraiment être clair …
 
            Je n'ai pas capté hier soir les lettres se suivant, c'est donc encore plus facile, surtout pour quelqu'un manipulant des boucles !
 
            Seule la fonction  Mid  est nécessaire pour isoler les caractères, sans voir le code, ce serait un scénario du genre
            d'une boucle de 2 jusqu'à la longueur de la chaîne, à chaque caractère égal au précédent, un compteur est incrémenté,
            si le compteur atteint la limite …


Message édité par Marc L le 27-03-2013 à 10:48:09
Reply

Marsh Posté le 29-03-2013 à 13:29:42    

 
            Pas de nouvelle ?
 

swissforever a écrit :

|…] ma priorité est la rapidité d'exécution car j'ai pas mal de ligne à créer!

            En intégrant mon scénario précédent dans le contrôle des boucles,
            en testant une génération de chaines de 4 caractères je n'ai pas gagné grand chose
            mais avec 5 caractères, j'ai dépassé les 10 secondes, donc avec 8, cela doit se chiffrer en minute(s) !
 

Reply

Marsh Posté le 30-03-2013 à 15:35:21    

Je peux jouer ? :D
 
Voilà une fonction qui teste si un caractère est présent plus de 3 fois dans une chaine de 8 caractères :
 

'Renvoie TRUE si la chaine ne contient pas plus de 3 caractères identiques
'Sinon, renvoie FALSE
Function EstValide(chaine As String) As Boolean
Dim tableau(7, 1) As String
Dim i As Integer, y As Integer
 
    'boucle sur la chaine de caractères
    For i = 1 To 8
        'Boucle sur le tableau de test : compte le nombre de caractères
        For y = 0 To 7
            If tableau(y, 0) = "" Then
                tableau(y, 0) = Mid(chaine, i, 1)
                tableau(y, 1) = 1
                Exit For
            ElseIf tableau(y, 0) = Mid(chaine, i, 1) Then
                tableau(y, 1) = tableau(y, 1) + 1
                If tableau(y, 1) > 3 Then Exit Function
                Exit For
            End If
        Next y
    Next i
    EstValide = True
End Function


 
J'ai testé cette fonction avec une liste de 65000 lignes de 8 caractères générés aléatoirement :

'Générer une liste de Nb chaines de 8 caractères
Sub GénérerListe()
Dim chaine As String
Dim i As Double
Dim Nb As Double
Dim td As Double
Dim tf As Double
 
    'Entête cellules :
    Cells(1, 1) = "Chaine": Cells(1, 2) = "Valide"
     
    'Donner le nombre maxi de lignes ci dessous
    '------------
    Nb = 65000
    '------------
     
    'Générer une liste de Nb chaines de 8 caractères
    td = Timer 'lancement du chrono
    For i = 2 To Nb + 1
        chaine = ChaineAleatoire
        Cells(i, 1) = chaine
    Next i
    tf = Timer 'arrêt du chrono
    MsgBox Nb & " chaines de caractères ont été générées aléatoirement en " & Round(tf - td, 2) & " seconde(s)"
End Sub
 
Function ChaineAleatoire() As String
Dim i As Integer
Dim c As Integer
Dim d As Integer
 
    For i = 1 To 8
        'Randomize
        c = Int(36 * Rnd) + 1
        'd = Int(5 * Rnd) + 1
        'If d = 0 And i > 1 Then
            'ChaineAleatoire = ChaineAleatoire & Chr(c)
            'Next i
        'End If
             
        If c < 11 Then
            c = c + 47
        Else
            c = c + 54
        End If
        ChaineAleatoire = ChaineAleatoire & Chr(c)
    Next i
End Function


 
Et enfin, le test sur ces 65000 lignes :

Sub TestVitesse()
Dim i As Double
Dim Nb As Double
Dim td As Double
Dim tf As Double
 
    'Entête cellules :
    Cells(1, 1) = "Chaine": Cells(1, 2) = "Valide"
     
    'Donner le nombre maxi de lignes ci dessous
    '------------
    Nb = 65000
    '------------
     
    'Tester si la chaine est valide
    td = Timer 'lancement du chrono
    For i = 2 To Nb + 1
        Cells(i, 2) = EstValide(Cells(i, 1))
    Next i
    tf = Timer 'arrêt du chrono
    MsgBox Nb & " chaines de caractères ont été testées en " & Round(tf - td, 2) & " seconde(s)"
End Sub


 
Chez moi, ça met environ 24 secondes à générer la liste et en moyenne 8.03 secondes pour la tester.
 
Par contre, entrer directement la fonction dans la feuille =ESTVALIDE(A2) et la recopier 65000 fois, ça rame dur à tout recalculer :/


---------------
OtObOxBlOg - - - Etre seul à avoir tort  c'est plus difficile, mais c'est bien plus beau que d'avoir raison avec une bande de cons
Reply

Marsh Posté le 30-03-2013 à 15:39:52    

Sinon, il y a peut être plus rapide, mais je n'ai pas testé :
Pour chaque chaine de caractère, trier les caractères dans l'ordre croissant.
Puis ensuite tester si plus de 3 caractères identiques se suivent.
 
Mais je ne suis pas certain que le tri dans l'ordre croissant de la chaine soit plus rapide que ma méthode...


---------------
OtObOxBlOg - - - Etre seul à avoir tort  c'est plus difficile, mais c'est bien plus beau que d'avoir raison avec une bande de cons
Reply

Marsh Posté le 30-03-2013 à 16:25:13    

Voilà une 2nde fonction, un poil plus rapide que la première (environ 7.2s), en passant par la méthode de compter les occurrences remplacées dans une chaine de caractères :

Function ESTVALIDE2(chaine As String) As Boolean
Dim i As Integer
Dim y As Integer
Dim NbLettresMaxi As String
Dim c As String

 

   'Nb de lettres identiques pour lequel la fonction devient fausse
    NbLettresMaxi = 3
    For i = 1 To 8 - NbLettresMaxi + 1
        c = Mid(chaine, i, 1)
        If (Len(chaine) - Len(Replace(chaine, c, "" ))) >= NbLettresMaxi Then Exit Function
    Next i
    ESTVALIDE2 = True
End Function


Message édité par otobox le 30-03-2013 à 16:26:16

---------------
OtObOxBlOg - - - Etre seul à avoir tort  c'est plus difficile, mais c'est bien plus beau que d'avoir raison avec une bande de cons
Reply

Marsh Posté le 30-03-2013 à 16:32:26    

 
           otobox, ta fonction EstValide est "compliquée" (et ne répond pas au problème exposé comme ESTVALIDE2) :
           y a pas besoin d'un tableau pour vérifier si un même caractère est répété à la suite n fois, il suffit d'un compteur …
 
           Ensuite vu la demande pour une question de rapidité, mieux vaut vérifier à chaque chaine générée.


Message édité par Marc L le 30-03-2013 à 16:36:23
Reply

Marsh Posté le 30-03-2013 à 16:32:26   

Reply

Marsh Posté le 30-03-2013 à 18:32:45    

Les 2 fonctions font exactement la même chose ;) à savoir détecter si un caractère est présent plus de 3 fois dans la chaine.
 
J'avais pas fait gaffe qu'il fallait que les 3 caractères se suivent (le sujet est : "Savoir si n'importe quel caractère défini est plusieurs fois" ).
 
Dans ce cas, un compteur pour vérifier si il y a 3 caractères d'affilés :

Function EstValide3(chaine As String) As Boolean
Dim i As Integer
Dim NbLettres As Integer
Dim c As Integer
 
    NbLettres = 3
    For i = 1 To Len(chaine) - 1
        If Mid(chaine, i, 1) = Mid(chaine, i + 1, 1) Then
            c = c + 1
            If c = NbLettres - 1 Then Exit Function
        Else
            c = 0
        End If
    Next i
    EstValide3 = True
End Function


Un peu plus rapide, environ 7 secondes pour 65000 lignes


---------------
OtObOxBlOg - - - Etre seul à avoir tort  c'est plus difficile, mais c'est bien plus beau que d'avoir raison avec une bande de cons
Reply

Marsh Posté le 30-03-2013 à 18:54:07    

Je gagne 1/2 seconde en supprimant quelques lignes :

Function EstValide4(chaine As String) As Boolean
Dim i As Integer

 

   For i = 1 To Len(chaine) - 2
        If Mid(chaine, i, 1) = Mid(chaine, i + 1, 1) Then
            If Mid(chaine, i, 1) = Mid(chaine, i + 2, 1) Then Exit Function
        End If
    Next i
    EstValide4 = True
End Function


Message édité par otobox le 30-03-2013 à 18:54:48

---------------
OtObOxBlOg - - - Etre seul à avoir tort  c'est plus difficile, mais c'est bien plus beau que d'avoir raison avec une bande de cons
Reply

Marsh Posté le 30-03-2013 à 19:36:30    

Et une dernière, après j'arrête :o

 

Function EstValide5(chaine As String) As Boolean
Dim i As Integer

 

   For i = 2 To 6 Step 2
        If Mid(chaine, i, 1) = Mid(chaine, i + 1, 1) Then
            If Mid(chaine, i, 1) = Mid(chaine, i - 1, 1) Then Exit Function
        End If
    Next i
    If Mid(chaine, i, 1) = Mid(chaine, i - 2, 1) Then Exit Function
    EstValide5 = True
End Function

 

Moyennes sur 10 exécutions (parcourir une liste de 6500 chaines aléatoires) :

Fonction EstValide4 :
6,55s 6,55s 6,55s 6,55s 6,56s 6,55s 6,55s 6,56s 6,55s 6,55s
Moyenne = 6,55 secondes
Fonction EstValide5 :
6,45s 6,45s 6,44s 6,45s 6,47s 6,44s 6,45s 6,45s 6,45s 6,45s
Moyenne = 6,45 secondes

 

Normal puisque pour chaque chaine de caractères,

  • dans la 4 je fais 7 itérations et au minimum 7 tests
  • dans la 5, je ne fais que 2 itérations et au minimum 4 tests.


Au final, pour 65000 lignes, je gagne 1/10e de seconde :D


Message édité par otobox le 30-03-2013 à 19:42:10

---------------
OtObOxBlOg - - - Etre seul à avoir tort  c'est plus difficile, mais c'est bien plus beau que d'avoir raison avec une bande de cons
Reply

Marsh Posté le 31-03-2013 à 13:43:44    

 
           otobox, tes fonctions EstValide3 & 4 OK mais la EstValide5 est incorrecte :

     If Mid(chaine, i, 1) = Mid(chaine, i - 2, 1) Then Exit Function

           car en sortie de boucle I vaut 8 et tu compares donc avec le 6è caractère, mais quid du 7ème ?‼
           Et donc c'est normal qu'elle soit plus rapide ! …
 

Reply

Marsh Posté le 01-04-2013 à 08:02:15    

Oui, tu as raison... oops !


---------------
OtObOxBlOg - - - Etre seul à avoir tort  c'est plus difficile, mais c'est bien plus beau que d'avoir raison avec une bande de cons
Reply

Marsh Posté le 01-04-2013 à 08:04:04    

Et toi ? tu as quelle solution avec quelle rapidité ?


---------------
OtObOxBlOg - - - Etre seul à avoir tort  c'est plus difficile, mais c'est bien plus beau que d'avoir raison avec une bande de cons
Reply

Marsh Posté le 01-04-2013 à 16:08:22    

 
           Ta fonction EstValide3 est quasi identique à la mienne !
           Ensuite je l'ai dérivée pour l'intégrer directement au moment de la génération,
           juste pour optimiser les boucles génératrices, du genre je suppose à celles du demandeur.
           Mais comme ce dernier n'a pas daigné répondre …
 

Reply

Marsh Posté le 05-04-2013 à 18:06:28    

Merci pour votre aide, j'avais en effet fait une erreur sur le pas plus de 2x.
 
J'imaginais aussi des codes comme ça mais je me demandais s'il existant une fonction déjà toute faite que je ne connaissais pas!
 
Pour finir vu que je vois que ça va faire genre 23To de données en calculant vite fait... ça fait encore pas mal alors que j'ai genre un HDD de 40Go externe a dispo...
 
En tout cas merci de votre aide!


---------------
Swisscore
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed