macro à compléter

Version imprimable

macro à compléter

Bonjour le forum,

J'ai 5 feuilles et lorsque la recherche se fait tout fonctionne mais lorsque ça arrive sur la feuille LOGICIELS - LICENCES la couleur continue sur la colonne E.
J'ai loupé quelque chose mais quoi?
Quelqu'un peut-il voir où se trouve la "bêtise" car elle elle doit-être ENORME?
Merci d'avance

Voici la macro:

Code:

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
Sub RechercherNoms()
Dim Sh As Worksheet
Dim c As Range
Dim Nom As String, firstAddress As String
 
Nom = InputBox("Nom à chercher dans toutes les feuilles", "Rechercher")
If Nom <> "" Then
    For Each Sh In ThisWorkbook.Worksheets
      'Sh.Range("A3:E" & Sh.Range("A" & Rows.Count).End(xlUp).Row).Interior.ColorIndex = xlNone
        Set c = Sh.Columns("A:E").Find(Nom, LookIn:=xlValues, LookAt:=xlPart)
        If Not c Is Nothing Then
            Sh.Activate
            c.Select
            firstAddress = c.Address
            Do
              If Sh.Name = "TOTO" Then
                Range("A" & c.Row & ":C" & c.Row).Interior.ColorIndex = 38
              Else
               If Sh.Name = "LOGICIELS - LICENCES" Then
                Range("A" & c.Row & ":D" & c.Row).Interior.ColorIndex = 38
              Else
              End If
                Range("A" & c.Row & ":E" & c.Row).Interior.ColorIndex = 38
              End If
              strreponse = MsgBox(Sh.Name & "!" & c.Address & vbCrLf & _
                 "Oui pour continuer la recherche" & vbLf & _
                 "Non pour sortir", vbYesNo)
                 If strreponse = vbNo Then Exit Sub
                Set c = Sh.Columns("A:E").FindNext(c)
                c.Select
            Loop While Not c Is Nothing And c.Address <> firstAddress
            Set c = Nothing
      End If
    Next Sh
End If
End Sub

10/01/2016, 09h06
graphikris

Bonjour,

Avant de déclencher ta macro, ouvre VBA (Alt + F11), tu réduit pour voir ton classeur Excel puis tu presses la touche F8. A chaque pression sur F8, ta macro se déroule pas a pas. Lorsque tu arrives sur ton erreur (colonne E coloriée), tu stoppes puis tu modifies ta macro.
10/01/2016, 09h13
Un Internaute

Bonjour graphikris,
Fait et ça n'accroche pas.
Je pense que c'est ENORME mais voit pas pour l'instant.
Merci à toi
10/01/2016, 09h17
graphikris

met ton fichier en lien

heu

onjour
pour moi il y a un end if en trop

Code:

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
Sub RechercherNoms()
Dim Sh As Worksheet
Dim c As Range
Dim Nom As String, firstAddress As String
 
Nom = InputBox("Nom à chercher dans toutes les feuilles", "Rechercher")
If Nom <> "" Then
    For Each Sh In ThisWorkbook.Worksheets
      'Sh.Range("A3:E" & Sh.Range("A" & Rows.Count).End(xlUp).Row).Interior.ColorIndex = xlNone
        Set c = Sh.Columns("A:E").Find(Nom, LookIn:=xlValues, LookAt:=xlPart)
        If Not c Is Nothing Then
            Sh.Activate
            c.Select
            firstAddress = c.Address
            Do
              If Sh.Name = "TOTO" Then
                Range("A" & c.Row & ":C" & c.Row).Interior.ColorIndex = 38
              Else
               If Sh.Name = "LOGICIELS - LICENCES" Then
                Range("A" & c.Row & ":D" & c.Row).Interior.ColorIndex = 38
              Else
              End If
                Range("A" & c.Row & ":E" & c.Row).Interior.ColorIndex = 38
              End If
              strreponse = MsgBox(Sh.Name & "!" & c.Address & vbCrLf & _
                 "Oui pour continuer la recherche" & vbLf & _
                 "Non pour sortir", vbYesNo)
                 If strreponse = vbNo Then Exit Sub
                Set c = Sh.Columns("A:E").FindNext(c)
                c.Select
            Loop While Not c Is Nothing And c.Address <> firstAddress
            Set c = Nothing
      End If
    Next Sh
End If
End Sub

mais tu aurais fait pluspropre avec un select case

Bonjour,

je ne comprend pas très bien ce que tu veux faire :

- feuille TOTO = colorier en colonne A à C
- autres feuilles : colorier en colonne A à E

il y a des feuilles dans le classeur qui ne doivent pas être traitées ??
par ailleurs, tu as mis en commentaire la ligne de code qui efface les couleurs avant de faire le traitement, c'est normal ?

voici un exemple à adapter ... ou alors il faut mieux préciser les choses pour qu'on puisse t'aider

- suppression des couleurs dans chaque feuille
- Recherche du mot
- Pour chaque ligne où figure le résultat : colorier la colonne A à E SAUF la feuille TOTO (colorier colonne A à C)

Code:

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
Sub RechercherNoms()
Dim Sh As Worksheet
Dim c As Range
Dim Nom As String, firstAddress As String
 
Nom = InputBox("Nom à chercher dans toutes les feuilles", "Rechercher")
 
If Nom <> "" Then
 
    For Each Sh In ThisWorkbook.Worksheets
        With Sh
            .Range("A3:E" & .Range("A" & .Rows.Count).End(xlUp).Row).Interior.ColorIndex = xlNone
 
            Set c = .Columns("A:E").Find(Nom, LookIn:=xlValues, LookAt:=xlPart)
 
            If Not c Is Nothing Then
 
                firstAddress = c.Address
 
                Do
                    If .Name = "TOTO" Then
                        .Range("A" & c.Row & ":C" & c.Row).Interior.ColorIndex = 38
                    Else
                        .Range("A" & c.Row & ":E" & c.Row).Interior.ColorIndex = 38
                    End If
 
                    strreponse = MsgBox(.Name & "!" & c.Address & vbCrLf & _
                                        "Oui pour continuer la recherche" & vbLf & _
                                        "Non pour sortir", vbYesNo)
 
                    If strreponse = vbNo Then Exit Sub
 
                    Set c = .Columns("A:E").FindNext(c)
 
                Loop While Not c Is Nothing And c.Address <> firstAddress
 
                Set c = Nothing
            End If
        End With
    Next Sh
End If
 
End Sub

UN EXEMPLE SELON TON PRINCIPE

Code:

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
Sub RechercherNoms()
    Dim Sh As Worksheet, c As Range, Nom As String, firstAddress As String, col1, col2
    Nom = InputBox("Nom à chercher dans toutes les feuilles", "Rechercher")
    If Nom <> "" Then
        For Each Sh In ThisWorkbook.Worksheets
            Select Case Sh.Name
            Case "TOTO"
                col2 = 3
            Case "LOGICIELS - LICENCES"
                col2 = 4
                'je supose que le END IF En trop etait pour le cas ou le nom du sheets etait diférent des deux premiers précédement cité!!!!?
                'donc on rajoute un CASE ELSE
            Case Else
                col2 = 5
            End Select
            With Sh
                .Activate    ' je te met activate ici pour que tu puisse voir le travail se faire mais c'est pas utilse
                Set c = .Range(.Cells(1, 1), .Cells(Rows.Count, col2)).Find(Nom, LookIn:=xlValues, LookAt:=xlPart)
                If Not c Is Nothing Then
                    firstAddress = c.Address
                    Do
                        .Range(.Cells(c.Row, 1), .Cells(c.Row, col2)).Interior.ColorIndex = 38
                        c.Select ' je te met le select ici pour que tu puisse voir le sheets se colorer au fur et a mesure mais c'est pas utile car les select et activate ralentissent la macro
                        strreponse = MsgBox(Sh.Name & "!" & c.Address & vbCrLf & _
                                            "Oui pour continuer la recherche" & vbLf & _
                                            "Non pour sortir", vbYesNo)
                        If strreponse = vbNo Then Exit Sub
                        Set c = .Range(.Cells(1, 1), .Cells(Rows.Count, col2)).FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> firstAddress
                    Set c = Nothing
                End If
            End With
        Next Sh
    End If
End Sub

Bonsoir le forum,
Excuez moi si je n'ai pu fournir le fichier mais il est très personnel.
Effectivement ça aurait été mieux il était même indispensable pour comprendre.
J'ai tout revu et ça fonctionne et c'est plus facile si on veut ajouter des feuilles.

Nouveaux codes car il y en a deux maintenant.

Code:

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
Sub RechercherNoms()
Dim Sh As Worksheet
Dim c As Range
Dim Nom As String, firstAddress As String
 
Nom = InputBox("Nom à chercher dans toutes les feuilles", "Rechercher")
If Nom <> "" Then
    For Each Sh In ThisWorkbook.Worksheets
      'Sh.Range("A3:E" & Sh.Range("A" & Rows.Count).End(xlUp).Row).Interior.ColorIndex = xlNone
        Set c = Sh.Columns("A:E").Find(Nom, LookIn:=xlValues, LookAt:=xlPart)
        If Not c Is Nothing Then
            Sh.Activate
            c.Select
            firstAddress = c.Address
            Do
              Select Case Sh.Name
                Case "TOTO"
                  Range("A" & c.Row & ":C" & c.Row).Interior.ColorIndex = 38
                Case "LOGICIELS - LICENCES"
                  Range("A" & c.Row & ":D" & c.Row).Interior.ColorIndex = 38
                Case Else
                  Range("A" & c.Row & ":E" & c.Row).Interior.ColorIndex = 38
              End Select
 
              strreponse = MsgBox(Sh.Name & "!" & c.Address & vbCrLf & _
                 "Oui pour continuer la recherche" & vbLf & _
                 "Non pour sortir", vbYesNo)
                 If strreponse = vbNo Then Exit Sub
                Set c = Sh.Columns("A:E").FindNext(c)
                c.Select
            Loop While Not c Is Nothing And c.Address <> firstAddress
            Set c = Nothing
      End If
    Next Sh
End If
End Sub

Autre code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub ReInitCouleurs()
Dim Ligne As Long, Sh As Worksheet, Colonne As Integer
Dim LaCouleur
Dim NbColonne As Integer
 
  LaCouleur = Array(36, 35, 40, 36, 35)
  For Each Sh In Sheets
    Ligne = Sh.Range("A" & Rows.Count).End(xlUp).Row
    If Sh.Name = "TOTO" Then
      NbColonne = 3
    ElseIf Sh.Name = "LOGICIELS - LICENCES" Then
    'If Sh.Name = "LOGICIELS - LICENCES" Then
      NbColonne = 4
    Else
      NbColonne = 5
    End If
    For Colonne = 1 To NbColonne
      Sh.Range(Sh.Cells(3, Colonne), Sh.Cells(Ligne, Colonne)).Interior.ColorIndex = LaCouleur(Colonne - 1)
    Next Colonne
  Next Sh
End Sub

11/01/2016, 07h38
Un Internaute

Bonjour le forum,
J'ai oublié hier au soir de remercier ceux qui ont bien voulu apporter leur pierre à la réalisation de nouveaux codes.
Avec toutes mes excuses
Merci patricktoulon, Merci joe.levrai et merci graphikris
Bonne journée à vous.
Bien cordialement