calcul d'occurrences en VB6 Résolu

Question

Bonjour , 

J'ai un petit programme en vb6 qui contient un bouton "Open" et une textbox .
lorsque je clique sur le bouton le contenu d'un fichier texte s'affiche dans la textbox.Alors par la suite j'ai voulu calculer le nombre de fois que la lettre "a" ou "A" apparaît dans mon texte et ça a fonctionné.Maintenant j'ai voulu faire la même chose avec tous les caractères possibles , c'est à dire que j'aurai un msgbox qui me donne combien de fois chaque caractère s'est répété dans le texte .Puisque je suis encore débutante en vb6 j'ai pas su comment le faire tt ce que je sais c'est qu'il y a 255 caractères en général .Merci à vous ! Voilà mon code :


Option Explicit
Dim chaine As String 'ma chaine de caractères 
Dim i As Integer
Dim nombredea As Integer

Private Sub command1_Click()

On Error GoTo erreur

Dim MyFile As String

MyFile = App.Path & "\hello.txt"  'le fichier texte

Open MyFile For Input As #1

Line Input #1, chaine
     
Close #1

Text1.Text = chaine

For i = 1 To Len(chaine)

If Mid(chaine, i, 1) = "a" Or Mid(chaine, i, 1) = "A" Then
         
         nombredea = nombredea + 1
        
         End If

Next i
    
MsgBox "le fichier contient la lettre A " & nombredea & " fois ", vbInformation, vbOKOnly

Exit Sub

erreur:

MsgBox "Fichier introuvable", vbExclamation

End Sub

EDIT: Ajout de la coloration syntaxique.

f894009 · Answer

Bonjour,

adaptez le debut pour avoir la chaine de votre fichier
ajoutez dans projet, references: microsoft scripting runtime

Private Sub Command1_Click()
    Dim Chaine, Nblettre As Long, lettre As String
    Dim obn As Object, cle As String, cles, k As Long, n As Long
    
    Chaine = "aAbBcC"
    Chaine = UCase(Chaine)
    Set obn = CreateObject("scripting.dictionary")
    For x = 1 To Len(Chaine)
        cle = Mid(Chaine, x, 1)
        If Not obn.Exists(cle) Then obn.Add cle, 1
    Next x

cles = obn.keys
    n = obn.Count
    For k = 0 To n - 1
        lettre = cles(k)
        Nblettre = 0
        For x = 1 To Len(Chaine)
            If Mid(Chaine, x, 1) = lettre Then
                Nblettre = Nblettre + 1
            End If
        Next x
        MsgBox "le fichier contient la lettre " & lettre & " " & Nblettre & " fois ", vbInformation, vbOKOnly
    Next k
End Sub

si vraiment beaucoup de caracteres (+500) dans chaine, il y a moyen de ne faire que deux boucles de comptage au lieu de trois

Private Sub Command2_Click()
    Set mondico = CreateObject("Scripting.Dictionary")
    Chaine = "aAbBcC"
    Chaine = UCase(Chaine)
    For x = 1 To Len(Chaine)
        cle = Mid(Chaine, x, 1)
        mondico(cle) = mondico(cle) + 1
    Next x
    TLettre = mondico.Keys
    TNblettre = mondico.Items
    For x = 0 To mondico.Count - 1
        MsgBox "le fichier contient la lettre " & TLettre(x) & " " & TNblettre(x) & " fois ", vbInformation, vbOKOnly
    Next x
End Sub

ThauTheme · Answer

Bonsoir Salouli, fnuméros, bonsoir le forum,

Peut-être comme ça :

Option Explicit

Private Sub command1_Click()
Dim chaine As String 'ma chaine de caractères
Dim I As Integer
Dim J As Integer
Dim TC(0 To 255) 'tableau des caractères

On Error GoTo erreur
Dim MyFile As String
MyFile = App.Path & "\hello.txt"  'le fichier texte
Open MyFile For Input As #1
     Line Input #1, chaine
Close #1
    Text1.Text = chaine
    For i = 1 To Len(chaine)
        For J = 0 To 255
            If Mid(chaine, i, 1) = Chr(J) Then
                TC(J) = TC(J) + 1
                Exit For
            End If
        Next J
    Next i
    
For J = 0 To 255
    Cells(J + 1, 8).Value = Chr(J) 'renvoie dans la colonne H le caractère (à adapter)
    Cells(J + 1, 9).Value = TC(J) 'renvoie dans la colonne G le nombre de caractères (à adapter)
Next J
'
'
'        If Mid(chaine, i, 1) = "a" Or Mid(chaine, i, 1) = "A" Then
'         nombredea = nombredea + 1
'         End If
'   Next i
'MsgBox "le fichier contient la lettre A " & nombredea & " fois ", vbInformation, vbOKOnly
Exit Sub
erreur:
MsgBox "Fichier introuvable", vbExclamation
End Sub

Salouli · Answer

Rebonjour ! 

Merci beaucoup les amis :)) vos réponses me sont tellement riches et utiles .

Calcul d'occurrences en VB6

3 réponses

Discussions similaires

Newsletters