repérer et compter une répétition de caractères dans une chaine.

[tkd2009]

Bonjour,

je souhaiterai repérer et récupérer les répétition de caractères dans une chaine.
Par exemple dans la chaine suivante:
"attcgaatgggtcaTATATATATATAagtccgattgg"
il y a une répétition de TA 6 fois consécutive....j'aimerai trouver un bout de code pour analyser cette chaine, identifier la répétiton et la compter...
Je suppose qu'il faut tester les caractères par paire avec une fonction MID et quand la paire est identique à la suivante on récupère et on compte, mais j'ai du mal à transcrire cela en VBA.

Pouvez vous m'aider?

Merci 😉

 

[mapomme]

Re : repérer et compter une répétition de caractères dans une chaine.

Bonsoir tkd2009,

Une fonction personnalisée : StringNcarQuoiCombien(S, n, Optional retour)

• S est la chaine où rechercher les caractères qui se répètent
• n est le nombre de caractères à rechercher (n = 2 -> on recherche la répétition de deux caractères)
• retour est un paramètre optionnel. S'il est absent, on retourne la chaine de n caractères qui se répète le plus. S'il est présent (et peut valoir n'importe quoi), on retourne le nombre de répétition+1.

nota: on recherche la chaine de n caractères qui se répète consécutivement le plus et au moins une fois. S'il y en a plusieurs qui se répètent le même nombre de fois , on retourne la première.


Attention! La fonction INSTR prend en compte l'état de l'option Compare en tête de module.
.

• Pour être certain de distinguer majuscule et minuscule, rajouter en-tête de module l'instruction Option Compare Binary
• Pour être certain de ne pas distinguer majuscule et minuscule, rajouter en-tête de module l'instruction Option Compare Text

.
Ou bien, on peut aussi directement paramétrer la fonction INSTR dans le code (mieux à mon avis)

• distinction Maj/Min écrire: InStr(1, Left(r, n), rech, vbBinaryCompare) ou
• pas de distinction Maj/Min écrire: InStr(1, Left(r, n), rech, vbTextCompare)

Function StringNcarQuoiCombien(S$, n&, Optional retour)
Dim i&, nbr&, max
Dim rech$, r$, repet

For i = 1 To Len(S) - n
  rech = Mid(S, i, n)
  r = Mid(S, i + n)
  nbr = 1
  Do Until Len(r) < n
    If InStr(Left(r, n), rech) > 0 Then
      nbr = nbr + 1
      r = Mid(r, n + 1)
    Else
      Exit Do
    End If
  Loop
  If nbr > max Then
    max = nbr
    repet = rech
  End If
Next i

If max < 2 Then
  repet = vbNullString
  max = vbNullString
End If

If IsMissing(retour) Then
  StringNcarQuoiCombien = repet
Else
  StringNcarQuoiCombien = max
End If

End Function

 

[mapomme]

Re : repérer et compter une répétition de caractères dans une chaine.

Bonsoir à tous,

Un exemple dans le fichier joint pour trouver toutes les répétitions au sein d'une chaine quand il y en a plusieurs. On combine la fonction personnalisée avec des formules.

 

[tkd2009]

Re : repérer et compter une répétition de caractères dans une chaine.

Un grand merci!
J'étais visiblement parti dans la mauvaise direction ou du moins une direction "usine à gaz".
Il ne me reste plus qu'à disséquer tout ça...

Bon week end 😉

 

[tkd2009]

Re : repérer et compter une répétition de caractères dans une chaine.

Finalement j'ai transformé ta fonction en sub à part entière:
pour chaque séquence je liste toutes les répétitions de 2 caractères sur une ligne avec au départ la plus grosse répétition.

Sub test()
Dim i As Integer, NbrRepet As Integer, MaxRepet As Integer, n As Integer
Dim Motif As String, RestSeq As String, Cel As Range

For Each Cel In Range("B3", Range("B1024000").End(xlUp).Rows)

n = 2 'nombre de caractères à rechercher (n = 2 -> on recherche la répétition de deux caractères)
MaxRepet = 0
    For i = 1 To Len(Cel.Value) - n
        Motif = Mid(Cel.Value, i, n)
        RestSeq = Mid(Cel.Value, i + n)
        NbrRepet = 1
    Do Until Len(RestSeq) < n
        If InStr(Left(RestSeq, n), Motif) > 0 Then
            NbrRepet = NbrRepet + 1            
            RestSeq = Mid(RestSeq, n + 1)
        Else
            Exit Do
        End If
    Loop

If NbrRepet > 4 And NbrRepet > MaxRepet Then
        MaxRepet = NbrRepet
        Cells(Cel.Row, 3).Value = "(" & Motif & ")" & MaxRepet
End If
If NbrRepet > 4 Then Cells(Cel.Row, Range("IV" & Cel.Row).End(xlToLeft).Column + 1).Value = "(" & Motif & ")" & NbrRepet
' on saute la répétition trouvée et on teste le reste de la séquence
i = i + ((NbrRepet - 1) * n)

Next i
next Cel

il ne reste plus qu'à répéter l'opération pour n=3, 4 et 5 et à faire un peu de mise en forme
Ci joint un fichier exemple...

un grand merci encore 🙂