Recherche de texte specifique avec/sans mise en forme

Bonjour,

J'aimerai créer une macro mais je suis totalement nul dans la progammation. J'ai bien essaye avec des formules mais je pense que mon problème est trop complexe pour des formules de bases, donc je me tourne vers vous.

J'ai joint mon fihcier excel comme exemple.

J'aimerai pouvoir faire une macro qui me cherche les termes R5 à R9 pour chaque colonne (fusionnee et non fusionee, en bleu). Si elle ne trouve pas un ou plusieurs des termes , la macro ecrit dans la case jaune ce/ces termes. De plus, si elle trouve un ou des termes avec la mise en forme barrée, la macro ecrit ce/ces termes toujours dans la case jaune.

J'ai bien essaye de commancer a écrire une macro avec des if et des cells.find() mais je me perds dans la multitude de fi `écrire.

Pourriez-vous m'aider ? Je ne sais pas si j'ai été bien clair.

Merci !

8exemple.xlsx (9.16 Ko)

Bonjour et bienvenue sur le forum

Ton souhait serait beaucoup plus facile à réaliser s'il n'y avait pas de cellules fusionnées. Celles-ci sont un cauchemard pour les macros.

Tu aurais donc intérêt à les remplacer par des cellules centrées sur plusieurs colonnes et l'aspect visuel serait identique.

OK ?

Bye !

Pour les cellules fusionnées ce n'est pas une obligation si pour les macro c'est un cauchemard. Disons que ce n'est qu'une convention d'écriture que l'on peut changer sans problème.

Donc considérons la cellule fusionnée sur la même colone que les autres.

Merci !

Salut Tribilbo, gmb,

si j'ai bien compris l'énoncé du problème...

'
iCol = UsedRange.Columns.Count
Cells(9, 1).Resize(1, iCol).ClearContents
For x = 1 To iCol
    iRow = Cells(Rows.Count, x).End(xlUp).Row
    sCol = Split(Columns(x).Address(ColumnAbsolute:=False), ":")(1)
    If iRow > 1 Then
        iOK = 0
        For y = 1 To iRow
            For Z = 5 To 9
                If Cells(y, x) Like "R" & Trim(Str(Z)) & "*" Then
                    If Range(sCol & y).Font.Strikethrough = True Then
                        Cells(9, x) = Cells(9, x) & "R" & Trim(Str(Z)) & " "
                        Range(sCol & 9).Characters(Len(Cells(9, x)) - 3, 2).Font.Strikethrough = True
                    Else
                        iOK = 1
                    End If
                End If
            Next
        Next
        If iOK = 0 Then
            For Z = 5 To 9
                Cells(9, x) = Cells(9, x) & "R" & Trim(Str(Z)) & " "
            Next
            Range(sCol & 9).Characters(Len(Cells(9, x)) - 15, 15).Font.Strikethrough = False
        End If
    End If
Next
'

A+

18exemple.xlsm (20.86 Ko)

Merci ! C est quasiment ca . J ai fait une erreur:

Tribilbo a écrit :

J'aimerai pouvoir faire une macro qui me cherche les termes R5 à R9 pour chaque colonne

En fait il fallait lire R1 a R9. J ai essaye de faire les modifs moi meme mais je dois avouer que je suis un peu perdu dans ce code. Aussi quand je rajoute des R5 ou autre dans les colonnes des dates suivantes qui sont vides dans mon exemple, la macro n affiche rien.

De plus, au 4 mars je n ai pas R9 d afficher, qu 6 mqrs R6 est qfficher deux fois, je ne le veux qu une fois.

Est ce que ce sont de grosses modifs a faire ?

Merci encore

Salut Tribilbo,

si j'ai bien compris...

'
iCol = UsedRange.Columns.Count
Cells(9, 1).Resize(1, iCol).ClearContents
For x = 1 To iCol
    iRow = Cells(Rows.Count, x).End(xlUp).Row
    sCol = Split(Columns(x).Address(ColumnAbsolute:=False), ":")(1)
    If iRow > 1 Then
        iOK = 0
        For y = 1 To iRow
            For Z = 1 To 9
                If Cells(y, x) Like "R" & Trim(Str(Z)) & "*" Then
                    If Range(sCol & y).Font.Strikethrough = True Then
                        sFlag = "R" & Trim(Str(Z))
                        If InStr(Cells(9, x), sFlag) = 0 Then Cells(9, x) = Cells(9, x) & "R" & Trim(Str(Z)) & " "
                        Range(sCol & 9).Characters(Len(Cells(9, x)) - 3, 2).Font.Strikethrough = True
                    Else
                        iOK = 1
                    End If
                End If
            Next
        Next
        If iOK = 0 Then
            For Z = 1 To 9
                Cells(9, x) = Cells(9, x) & "R" & Trim(Str(Z)) & " "
            Next
            Range(sCol & 9).Characters(Len(Cells(9, x)) - 15, 15).Font.Strikethrough = False
        End If
    End If
Next
'

A+

24exemple.xlsm (22.67 Ko)

Bonjour, malheureusement ce n'est pas encore tout à fait ca.

Pour étre plus clair je vais donner deux exemples:

Colonne A

R1

R2

R3

J'aimerai que la macro affiche dans la case A9: R4 R5 R6 R7 R8 R9

Colonne C

R5

R6

R7

R8

J'aimerai que la macro affiche dans la case C9: R1 R2 R3 R4 R5 R9

Si vous avez des questions n'hésitez pas !

Merci encore pour votre aide.

Salut Tribilbo,

Ok, j'avais mal interprété l'énoncé de départ! Au temps pour moi!

Je te fais ça... quand je peux!

A+

Salut Tribilbo,

voilà ton fichier!

'
Dim tTab(10) As Integer
'
iCol = UsedRange.Columns.Count
Cells(9, 1).Resize(1, iCol).ClearContents
'
For x = 1 To iCol
    iRow = Cells(Rows.Count, x).End(xlUp).Row
    sCol = Split(Columns(x).Address(ColumnAbsolute:=False), ":")(1)
    If iRow > 1 Then
        Erase tTab
        For y = 1 To iRow
            If Left(Cells(y, x), 1) = "R" Then tTab(Val(Mid(Cells(y, x), 2, 1))) = IIf(Range(sCol & y).Font.Strikethrough = True, 2, 1)
        Next
        For y = 1 To 9
            If tTab(y) <> 1 Then Cells(9, x) = Cells(9, x) & "R" & Trim(Str(y)) & " "
        Next
        iIdx = -1
        For y = 1 To 9
            If tTab(y) <> 1 Then
                iIdx = iIdx + 1
                Range(sCol & 9).Characters(1 + (iIdx * 3), 2).Font.Strikethrough = IIf(tTab(y) = 2, True, False)
            End If
        Next
    End If
Next
'

A+

13exemple.xlsm (22.51 Ko)

Super merci !!!!!

C'est exactement ca. Maintenant je n'ai plus qu'a comprendre le code et le modifier pour mes besoins (ce que j'ai réussi rapidement).

Merci beaucoup de ton temps.

Bonjour,

J'ai essayé de comprendre le code et j'ai mis des annotations. Je voulais juste savoir si j'ai bien compris les différentes commandes.

Private Sub cmdGO_Click()
'
Dim tTab(10) As Integer
' tab pour la declaration d'un tableau à 1 dimension de 10 lignes

iCol = UsedRange.Columns.Count
'Usedrange pour selectionner toutes les cellules utiliser dans le tableau
'Columns.count compte les colonnes utilisees et renvoi la derniere

Cells(9, 1).Resize(1, iCol).ClearContents
'de la cellule 9.1 a la derniere colonne du tableau (ligne 9 colonne=usedrange.columns.count) on efface

For x = 1 To iCol
    iRow = Cells(Rows.Count, x).End(xlUp).Row
'rows.count decompte nombre de ligne utilisée et colonne=x. Commence par derniere ligne non vide, remonte de 1 ceci afin pour ne pas prendre en compte la date.

    sCol = Split(Columns(x).Address(ColumnAbsolute:=False), ":")(1)
'En gros défini la colonne a traiter

    If iRow > 1 Then
'iRow=1 donc colonne avec seulement la date

        Erase tTab
'Si il y a d'autre chose que la date dans la colonne alors on efface le tableau ttab

        For y = 1 To iRow
            If Left(Cells(y, x), 1) = "R" Then tTab(Val(Mid(Cells(y, x), 2, 1))) = IIf(Range(sCol & y).Font.Strikethrough = True, 2, 1)
'Si le charactere de gauche dans la cellule 1,1 =R alors retourne la chaine de charactere de la cellule 1,1 en commencant par le charactere numero 2 d'une longueur de 1
'Val pour transformer chaine de texte en nombre
'A mettre dans le tableau ttab
'IIF test si la cellule est en charactere barre. Si oui=2, si non=1

        Next
        For y = 1 To 9
            If tTab(y) <> 1 Then Cells(9, x) = Cells(9, x) & "R" & Trim(Str(y)) & " "
'Si les valeurs du tableau n'est pas egal a 1 (pourquoi 1 ?) alors dans la cellule 9,x ecrire R + le nombre (trim enleve les espaces) + espace
        Next
        iIdx = -1
        For y = 1 To 9
            If tTab(y) <> 1 Then
                iIdx = iIdx + 1
                Range(sCol & 9).Characters(1 + (iIdx * 3), 2).Font.Strikethrough = IIf(tTab(y) = 2, True, False)
' ecriture en barrée mais pas compris
            End If
        Next
    End If
Next
'
End Sub

Merci !

Salut Tribilbo,

8/10

  • Pourquoi 1? tTab reprend les R... existants dans tes colonnes : 1 = existant, 2 = existant barré.. Comme tu ne gardes que les existants barrés, il faut éviter de reprendre les existants 'simples', donc <> 1 ;
  • Range(sCol & 9).Characters(1 + (iIdx * 3), 2).Font.Strikethrough = IIf(tTab(y) = 2, True, False)
La cellule-réponse étant complète, on traite les barrés, selon leur position (y) dans tTab --> d'où iIdx=iIdx+1.

On ne peut pas utiliser la variable de boucle y puisque certains tTab(y)=0 (position incertaine).

La propriété 'Characters' de Range permet de cibler la portion de cellule à barrer, dans ce cas-ci.

1+iIdx*3 = position de départ. Si, par ex. en 3e (iIdx= 2) position : 1 + (2*3) = 7 car 2 précédents qui occupent chacun 3 caractères (R1 + l'espace)

...,2) car on ne barre que 2 caractères depuis la position de départ.

CQFD !

Bienvenue en VBA!

A+

Merci pour les dernières précisions. Je vais maintenant m'amuser à l'adapter à mon vrai tableur.

A bientôt si j'ai d'autres questions

Rechercher des sujets similaires à "recherche texte specifique mise forme"