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