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

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : [VBA] Savoir si n'importe quel caractère défini est plusieurs fois...

swissforever

i7 Inside

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

Message cité 2 fois

Publicité

swissforever

i7 Inside

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

tarteflambee

Bonjour,

je n'ai pas la réponse 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).

Marc L

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 …

Marc L

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

Marc L

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) !

otobox

Maison fondée en 2005

Je peux jouer ?

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

otobox

Maison fondée en 2005

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

otobox

Maison fondée en 2005

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

Marc L

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

Publicité

otobox

Maison fondée en 2005

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

otobox

Maison fondée en 2005

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

otobox

Maison fondée en 2005

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

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

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

Marc L

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 ! …

otobox

Maison fondée en 2005

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

otobox

Maison fondée en 2005

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

Marc L

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 …

swissforever

i7 Inside

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

FORUM HardWare.fr

Programmation

VB/VBA/VBS

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

Sujets relatifs
VBA supprimer cours de bourse	Aide pour faire suivre un select case sur plusieurs cellules
Programme VBA trouvant une valeur répondant à des conditions ET/OU	SOS VBA Besoin d'aide pour un programme
Lancer invite de commande en VBA	Chaine de caractère entre dièse inattendu
Ecritude dans un fichier.bat à partir de VBA	problème programmation VBA
Diviser ma liste de news sur plusieurs pages	Extraction chaine de caractere variable [RESOLU]
Plus de sujets relatifs à : [VBA] Savoir si n'importe quel caractère défini est plusieurs fois...

Page générée en 0.039 secondes