Discussion :

[fllyann]

Bonjour

désolé d'abuser de vos connaissances mais j'ai un petit problème.

Je fais une boucle de test sur une colonne où quand je trouve un nom_projet j'extraie le projet.

truc_nom_projet.truc='projet'

mais parfois je tombe sur des :

nom_projet.truc_inutile

dans une cellule donc puisque je fais une recherche sur le nom_projet ma boucle tente d'extraire quelque chose qui n'existe pas et me provoque une erreur.

comment tester la présence d'un "=" ou un ' dans une cellule ?


Merci pour vos futures réponses.

[pgz]

Bonjour.

Je ne suis pas sûr d'avoir compris. Tu peux essayer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Macellule.value LIKE "*='*'" then

Cordialement,

PGZ

[Philippe Tulliez]

Bonjour,
Si les noms sont dans la colonne A

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
If InStr(Cells(r, 1), "nom_projet") Then
  ' Ici code pour extraire le projet
  End If

R représente la ligne

[fllyann]

Merci à vous deux

Alors pour le programme de pgz

j'ai mit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
If laCell.Value Like "*='*'" Then
'extraction du nom du porjet de la cellule trouvé par appel à la fonction n°1
projetColonneD = extraire_partiel_Colonne_D(Range(laCell.Address))

Mon programme
puis un Else
puis le reste de mon programme

ça marche très bien mais uniquement pour le 1er Nom_projet après il sort du programme sans indiquer d'erreur

EDIT : enfaite c'est une erreur de moi, je n'avais pas remit le loop dans les deux cas... maintenant j'ai un nouveau problème j'ai deux loop until pour un seul Do

car dans le 1er cas, si il y a un = alors j'exécute mon programme puis je loop
dans le 2èùe cas , pas de = alors je loop directement


Sinon corona, je n'ai pas exactement comprit comment fonctionnait ton programme ( dire que j'étais déjà sur InStr sans rien comprenre avant de poster... )

[Philippe Tulliez]

Bonsoir,
Extrait de l'aide en ligne

InStr, fonction
Renvoie une valeur de type Variant (Long) indiquant la position de la première occurrence d'une chaîne à l'intérieur d'une autre chaîne.

Imaginons que tu cherches Toto dans la cellule A1 (ici représentée par la variable maCellule qui contient "Son nom est Toto le héros".
Lorsque l'on utilise Instr(maCellule,"Toto") la fonction va renvoyer la position de Toto dans maCellule cad ici 13.
Si Toto n'est pas présent dans la chaine de caractères il renverra 0 donc quand tu écris if instr(maCellule,'Toto") then ... Il interprétera le code si instr est <> de 0.
L'instruction VBA inStr fait la même chose que CHERCHE et TROUVE dans Excel à l'exception de sa syntaxe qui est inversée et aussi qu'un message d'erreur est renvoyé à la place de zéro si la chaîne n'est pas trouvée.

[pgz]

Re,

enfaite c'est une erreur de moi, je n'avais pas remit le loop dans les deux cas... maintenant j'ai un nouveau problème j'ai deux loop until pour un seul Do

car dans le 1er cas, si il y a un = alors j'exécute mon programme puis je loop
dans le 2èùe cas , pas de = alors je loop directement

Ce serait plus clair si tu montrais le code qui cause pb.

PGZ

[fllyann]

Ah okay corona, je n'avais pas interprété comme ça... erreur encore une....
Mais moi enfaite il me faut rechercher toto et qu'il y est un = mais je ne peux pas mettre exactement ce que j'attends dans ma cellule car ça varie...

Voici mon code, j'espère qu'il n'est pas trop illisible moi je le trouve claire.... bon l'instanciation n'est pas encore fini... ainsi que le nom des variable...
je pensais mettre le If dans la fonction n°1 mais impossible je crois...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
'fonction pour extraire partiellement du texte d'une cellule de la colonne D
'fonction n°1
Function extraire_partiel_Colonne_D(texto As String) As String
    separe = Split(texto, "'")
    extraire_partiel_Colonne_D = Right(separe(1), Len(separe(1)) - InStr(separe(1), "'"))
End Function
 
'fonction pour extraire partiellement du texte d'une cellule de la colonne A
'fonction n°2
Function extraire_partiel_Colonne_A(texto As String) As String
    separe = Split(texto, "/")
    extraire_partiel_Colonne_A = Right(separe(1), Len(separe(1)) - InStr(separe(1), " "))
End Function
 
Sub RechercheErreurNomDeProjet()
Static erreurNum As Integer
 
Dim ligne1 As Integer, erreurNum2 As Integer, numeroDeLigne As Integer
Dim nom As String, memeAdressePremCell As String, motRecherche As String
Dim feuilleErreur As Worksheet
Dim bFounded As Boolean
Dim laCell As Range
Worksheets("TestType").Activate
 
'on recherchera "PTE_Ref"
motRecherche = "PTE_Ref"
 
Set laCell = Worksheets("TestType").Columns("D").Find(motRecherche, , xlValues, xlPart)
 
    If Not laCell Is Nothing Then
        'mémoriser l'adresse de cette première cellule trouvée
        memeAdressePremCell = laCell.Address
Do
 
 
'extraction du nom du porjet de la cellule trouvé par appel à la fonction n°1
projetColonneD = extraire_partiel_Colonne_D(Range(laCell.Address))
 
 
Range(laCell.Address).Select
 
ligne1 = ActiveCell.Row
Range("A" & ligne1).Select
 
' Boucle tant que la cellule est vide, on remonte
Do While (IsEmpty(ActiveCell))
        ActiveCell.Offset(-1, 0).Select
Loop
numeroDeLigne = ActiveCell.Row:
 
 
 
'extraction du nom du porjet de la cellule trouvé par appelle à la fonction n°2
projetColonneA = extraire_partiel_Colonne_A(Range("A" & numeroDeLigne))
 
 
'Boucle de test pour savoir si les deux projets ont le même nom
If projetColonneA = projetColonneD Then
 
Else
 
For Each page In ActiveWorkbook.Worksheets
    If page.Name = "erreurs" Then
        bFounded = True
        Exit For
    Else
        'rien à faire
    End If
Next
 
If Not bFounded Then
 
'J 'ajoute une feuille & je change le nom
    Set feuilleErreur = Sheets.Add(After:=Sheets(Sheets.Count))
    feuilleErreur.Name = "erreurs"
Else
'rien à faire puisque la page "erreur" a été trouvée
End If
 
erreurNum = erreurNum + 1
'---- ecrire dans la page erreurs; nom du projet; adresse colonne A; puis nom du projet; adresse colonne D
Range("A:D").WrapText = True
Worksheets("erreurs").Range("A" & erreurNum).Value = "Projet Colonne A " & projetColonneA
Worksheets("erreurs").Range("B" & erreurNum).Value = "A" & numeroDeLigne
Worksheets("erreurs").Range("C" & erreurNum).Value = "Projet Colonne D " & projetColonneD
Worksheets("erreurs").Range("D" & erreurNum).Value = "" & laCell.Address
Worksheets("TestType").Activate
Range(laCell.Address).Select
 
 End If
 
 'trouver la cellule suivante contenant le texte recherché
            Set laCell = Worksheets("TestType").Columns("D").FindNext(laCell)
 
         'boucler jusqu'à que l'on arrive à la dernière cellule
        Loop Until laCell.Address = memeAdressePremCell
End If
End Sub

[pgz]

Hello,

Je m'attendais à trouver le bout de code dont on discute, mais je ne le vois pas.

PGZ

[fllyann]

Ah mince j'ai mit la dernière version du code que j'avais pas celle avec la dernière modification

Alors 1er essais à ne pas tenter:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Function extraire_partiel_Colonne_D(texto As String) As String
If laCell.Value Like "*='*'" Then
    separe = Split(texto, "'")
    extraire_partiel_Colonne_D = Right(separe(1), Len(separe(1)) - InStr(separe(1), "'"))
    Else
    End If
End Function

Sinon dans le code j'avais tenté

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
If laCell.Value Like "*='*'" Then
'extraction du nom du porjet de la cellule trouvé par appel à la fonction n°1
projetColonneD = extraire_partiel_Colonne_D(Range(laCell.Address))
'----------Programme---------------- 
 
 
         'boucler jusqu'à que l'on arrive à la dernière cellule
        Loop Until laCell.Address = memeAdressePremCell
Else
 
 
         'boucler jusqu'à que l'on arrive à la dernière cellule
        Loop Until laCell.Address = memeAdressePremCell
    End If
End If
End Sub

Et à ce niveau le problème c'est que j'ai deux Loop Until pour un Do

[pgz]

Re,

Je n'ai pas compris ce que tu as fait, mais :
Tu devrais respecter les règles d'indentation pour rendre plus lisible
Par ailleurs, je ne vois pas pourquoi tu as écris 2 fonctions qui font exactement la même chose!

Après, il serait bien que tu apprennes à ne plus faire de .select qui ne soient pas utiles à l'opérateur.

Bon, à tout hasard, tu peux essayer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
'fonction pour extraire partiellement du texte d'une cellule de la colonne D
'fonction n°1
Function extraire_partiel(texto As String) As String
If laCell.Value Like "*='*'" Then
    separe = Split(texto, "'")
    extraire_partiel = Right(separe(1), Len(separe(1)) - InStr(separe(1), "'"))
Else
    extraire_partiel = vbNullString
End If
End Function
 
Sub RechercheErreurNomDeProjet()
Static erreurNum As Integer
 
Dim ligne1 As Integer, erreurNum2 As Integer, numeroDeLigne As Integer
Dim nom As String, memeAdressePremCell As String, motRecherche As String
Dim feuilleErreur As Worksheet
Dim bFounded As Boolean
Dim laCell As Range
Worksheets("TestType").Activate
 
'on recherchera "PTE_Ref"
motRecherche = "PTE_Ref"
 
Set laCell = Worksheets("TestType").Columns("D").Find(motRecherche, , xlValues, xlPart)
 
If Not laCell Is Nothing Then
    'mémoriser l'adresse de cette première cellule trouvée
    memeAdressePremCell = laCell.Address
 
    Do
 
        'extraction du nom du porjet de la cellule trouvé par appel à la fonction n°1
        projetColonneD = extraire_partiel(Range(laCell.Address))
 
 
        Range(laCell.Address).Select
 
        ligne1 = ActiveCell.Row
        Range("A" & ligne1).Select
 
        ' Boucle tant que la cellule est vide, on remonte
        Do While (IsEmpty(ActiveCell))
            ActiveCell.Offset(-1, 0).Select
        Loop
        numeroDeLigne = ActiveCell.Row:
 
 
 
        'extraction du nom du porjet de la cellule trouvé par appelle à la fonction n°2
        projetColonneA = extraire_partiel(Range("A" & numeroDeLigne))
 
 
        'Boucle de test pour savoir si les deux projets ont le même nom
        If (projetColonneA = projetColonneD) And (projetColonneA <> vbNullString) Then
 
        Else
 
            For Each Page In ActiveWorkbook.Worksheets
                If Page.Name = "erreurs" Then
                    bFounded = True
                    Exit For
                Else
                'rien à faire
                End If
            Next
 
            If Not bFounded Then
 
                'J 'ajoute une feuille & je change le nom
                Set feuilleErreur = Sheets.Add(After:=Sheets(Sheets.Count))
                feuilleErreur.Name = "erreurs"
            Else
                'rien à faire puisque la page "erreur" a été trouvée
            End If
 
            erreurNum = erreurNum + 1
            '---- ecrire dans la page erreurs; nom du projet; adresse colonne A; puis nom du projet; adresse colonne D
            Range("A:D").WrapText = True
            Worksheets("erreurs").Range("A" & erreurNum).Value = "Projet Colonne A " & projetColonneA
            Worksheets("erreurs").Range("B" & erreurNum).Value = "A" & numeroDeLigne
            Worksheets("erreurs").Range("C" & erreurNum).Value = "Projet Colonne D " & projetColonneD
            Worksheets("erreurs").Range("D" & erreurNum).Value = "" & laCell.Address
            Worksheets("TestType").Activate
            Range(laCell.Address).Select
 
        End If
 
        'trouver la cellule suivante contenant le texte recherché
        Set laCell = Worksheets("TestType").Columns("D").FindNext(laCell)
 
    'boucler jusqu'à que l'on arrive à la dernière cellule
    Loop Until laCell.Address = memeAdressePremCell
 
End If
 
End Sub

Je n'ai pas cherché à nettoyer tout cela. J'ai juste indenté et posé une condition.

Cordialement,

[fllyann]

Merci bien pgz,

l'indentation n'était pas réellement faite car le code est pour l'instant en travail après il aurait été optimisé et ré-indenté.

Sinon pour les deux fonctions, elles ne font pas la même chose, l'une doit extraire un texte entre ' et ' et l'autre doit extraire un texte entre un espace et /.

Sinon pour les select... mauvaise habitude

Merci en tout cas je vais tester/retoucher ça directement !

[pgz]

Sinon pour les deux fonctions, elles ne font pas la même chose, l'une doit extraire un texte entre ' et ' et l'autre doit extraire un texte entre un espace et /.

Au temps pour moi. Mais tu devrais pouvoir restaurer facilement les 2 fonctions en adaptant ce que je t'ai envoyé.

Attention quand même : l'indentation ce n'est pas pour faire joli au regard d'un tiers. C'est pour soit quand on développe!

Cordialement,

PGZ

[fllyann]

Tu as raison, je me tape actuellement

Sinon voici l'erreur quand j'exécute le programme et ça me surligne la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If laCell.Value Like "*='*'" Then

avec l'erreur :

Erreur d'exécution'424':

Objet requis

Pour cela que j'avais tenté de mettre le teste dans le Sub et non dans la Function.
Mais ça ne fonctionnait pas non plus...
Je cherche !

[pgz]

Décidément, je ne suis pas en forme. Correction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Function extraire_partiel(texto As String) As String
If texto Like "*='*'" Then
    separe = Split(texto, "'")
    extraire_partiel = Right(separe(1), Len(separe(1)) - InStr(separe(1), "'"))
Else
    extraire_partiel = vbNullString
End If
End Function

Ca devrait aller mieux...

Si ça ne va toujours pas, remets tout le code modifié.

PGZ

[mercatog]

Bonjour à tous
Une intrusion dans le sujet

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Option Explicit
'fonction pour extraire partiellement du texte d'une cellule de la colonne A ou D
'Colonne D: Sepd="'", Sepf="'"                Colonne 1:Sepd="/", sepf=" "
 
Function Extraire_Partiel_Colonne(Texto As String, Sepd As String, Sepf As String) As String
Dim Separe
 
Separe = Split(Texto, Sepd)
If UBound(Separe) > 0 Then Extraire_Partiel_Colonne = Right(Separe(1), Len(Separe(1)) - InStr(Separe(1), Sepf))
End Function
 
Sub RechercheErreurNomDeProjet()
Dim FeuilleErreur As Worksheet
Dim memeAdressePremCell As String, motRecherche As String, projetColonneD As String, projetColonneA As String
Dim Ligne1 As Integer, NumeroDeLigne As Integer, erreurNum As Integer
Dim laCell As Range
 
Application.ScreenUpdating = False
On Error Resume Next
Set FeuilleErreur = Sheets("erreurs")
erreurNum = FeuilleErreur.Cells(Rows.Count, 1).End(xlUp).Row
On Error GoTo 0
If FeuilleErreur Is Nothing Then
     Set FeuilleErreur = Sheets.Add(After:=Sheets(Sheets.Count))
     FeuilleErreur.Name = "erreurs"
End If
 
Worksheets("TestType").Activate
'on recherchera "PTE_Ref"
motRecherche = "PTE_Ref"
With Worksheets("TestType").Columns("D")
     Set laCell = .Find(motRecherche, , xlValues, xlPart)
     If Not laCell Is Nothing Then
          'mémoriser l'adresse de cette première cellule trouvée
          memeAdressePremCell = laCell.Address
          Do
               If laCell.Value Like "*=*'*" Then
                    'extraction du nom du porjet de la cellule trouvé par appel à la fonction n°1
                    projetColonneD = Extraire_Partiel_Colonne(laCell.Value, "'", "'")
                    Ligne1 = laCell.Row
                    NumeroDeLigne = laCell.Offset(0, -3).End(xlUp).Row
                    'extraction du nom du porjet de la cellule trouvé par appelle à la fonction n°2
                    projetColonneA = Extraire_Partiel_Colonne(Worksheets("TestType").Range("A" & NumeroDeLigne), "/", " ")
                    'Boucle de test pour savoir si les deux projets ont le même nom
                    If UCase(projetColonneA) <> UCase(projetColonneD) Then
                         erreurNum = erreurNum + 1
                         '---- ecrire dans la page erreurs; nom du projet; adresse colonne A; puis nom du projet; adresse colonne D
                         With FeuilleErreur
                              .Range("A" & erreurNum).Value = "Projet Colonne A " & projetColonneA
                              .Range("B" & erreurNum).Value = "A" & NumeroDeLigne
                              .Range("C" & erreurNum).Value = "Projet Colonne D " & projetColonneD
                              .Range("D" & erreurNum).Value = "" & laCell.Address(0, 0)
                              .Range("A:D").WrapText = True
                         End With
                    End If
               End If
               'trouver la cellule suivante contenant le texte recherché
               Set laCell = .FindNext(laCell)
               'boucler jusqu'à que l'on arrive à la dernière cellule
          Loop While Not laCell Is Nothing And laCell.Address <> memeAdressePremCell
     End If
End With
Set FeuilleErreur = Nothing
End Sub

[fllyann]

Pour pgz : Super ça fonctionne ! le teste se fait bien et me ressort mes erreurs dans ma page erreur sauf qu'il n'affiche plus les titres, je devrais réussir à trouver pourquoi et à réparer cette erreur.

Merci à toi pour ton temps passé à m'aider !

au faite juste pour détailler mon programme, il y a surement une incompréhension quand j'avais voulu l'expliquer

Enfaite je veux que quand je trouve un Tru_PTE_Ref_Truc='projet'
je veux extraire le projet pour pouvoir le tester puis boucler sur le PTE_Ref prochain

et quand je suis dans le cas où j'ai Tru_PTE_Ref_Truc ( sans ='projet') je veux simplement boucler au PTE_Ref prochain

donc dans la fonction j'ai enlevé le ( extraire_partiel = vbNullString )
et dans le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If (projetColonneA = projetColonneD) And (projetColonneA <> vbNullString) Then

j'ai enlevé le And (projetColonneA<>vbNullString)

ça à l'aire plus compréhensible ?


Merci aussi Mercatog et corona !

[fllyann]

Petite désillusion

enfaite mon programme après le 1er teste ne voit plus les projet donc renvoie forcément une erreur


Merci à mercatog qui m'a ouvert les yeux en me demandant de tester.

Bon je n'ai plus qu'à débugger le truc

edit :Il fallait simplement changer le "*='*'" par "*=*" dans la fonction n°1
maintenant il faut juste que je trouve comment faire pour pas qu'il me ressorte l'exception comme une erreur.

Merci en tout cas à vous trois !