Discussion :

[tarmin]

Bonjour,

j'ai récupéré ce code que j'ai un peu modifié et qui allait jusque là... Mais maintenant je dois faire la même chose mise à part qu'il faut contrôler la saisie qui est fait sur la feuil2 sur totalité des feuilles du classeur sauf la feuil2 bien entendu et la feuil3... Si quelqu'un pouvait me donner un coup d'pouce ce serait fort sympa ! Petite précision le nombre de feuille peut-être aléatoire...

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
Sub emp2()
  Dim wksSource As Worksheet
  Dim wksDest As Worksheet
  Dim rSource As Range
  Dim c As Range ' cellule source
  Dim d As Range ' cellule destination
  Dim i As Integer
 
  Set wksSource = Sheets("Feuil2")
  Set wksDest = Sheets("Feuil1")
 
  Set rSource = Range(wksSource.[A1], _
                      wksSource.Cells(wksSource.Cells.SpecialCells(xlLastCell).Row, 1))
  For Each c In rSource
    Set d = TrouveNumero(c.Value, wksDest)
'    For i = 1 To 6
      AjouteValeur c.Offset(0, i), d, i
'    Next i
  Next c
End Sub
 
Function TrouveNumero(sValue As String, Wks As Worksheet) As Range
  Dim c As Range
  Set c = Wks.Columns(1).Find(What:=sValue, LookAt:=xlWhole, MatchCase:=False)
  If c Is Nothing Then
    ' Attention, la feuille destination doit avoir, au moins, une ligne remplie
    Set c = Wks.Cells(Wks.Cells.SpecialCells(xlLastCell).Row + 1, 1)
    c = sValue
  End If
  Set TrouveNumero = c
End Function
 
Sub AjouteValeur(sValue As String, DestCell As Range, nCol As Integer)
nCol = 2
    If DestCell = "" Then
    Exit Sub
    Else
  If IsEmpty(DestCell.Offset(0, nCol)) Then
    DestCell.Offset(0, nCol) = "new"
  Else
    MsgBox DestCell & " Déjà saisie", vbCritical
   ' Exit Sub
    If InStr(1, DestCell.Offset(0, nCol), sValue) = " " Then
      DestCell.Offset(0, nCol) = DestCell.Offset(0, nCol) & " "
    End If
    End If
    End If
End Sub

[Godzestla]

Bonjour

Pour boucler sur les sheet,
tu peux faire :

Code :

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

1
2
3
4
5
6
7
8
 
    Set wksDest = Sheets("Feuil1")
    For Sheet_number = 1 to Sheets.Count
        Set wksSource = Sheets(Sheet_Number)
        If wkSource <> wksDest 
       ' code detail
        endif
    Next

[tarmin]

Merci pour la réponse mais malheureusement je n'y parvient pas... le code ne passe pas. Il bloque au niveau du

Code :

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

If wksSource <> wksDest

[mayekeul]

et il renvoie quelle erreur?

[tarmin]

Elle renvoie l'erreur suivante :
"Erreur d'exécution '438'
Propriété ou méthode non gérée par cet objet"

[zyhack]

Bonjour

si je peut me permettre en modifiant le code d'origine je verrais le code plutot comme ça

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
Sub emp2()
  Dim wksSource As Worksheet
  Dim wksDest As Worksheet
  Dim rSource As Range
  Dim c As Range ' cellule source
  Dim d As Range ' cellule destination
  Dim i As Integer
 
  Set wksSource = Sheets("Feuil2")
 
  For Each wksDest In Worksheets
    If wksDest.Name <> "Feuil2" And wksDest.Name <> "Feuil3" Then
 
      Set rSource = Range(wksSource.[A1], _
        wksSource.Cells(wksSource.Cells.SpecialCells(xlLastCell).Row, 1))
      For Each c In rSource
        Set d = TrouveNumero(c.Value, wksDest)
'    For i = 1 To 6
        AjouteValeur c.Offset(0, i), d, i
'    Next i
      Next c
    End If
  Next
End Sub

non ?

[mayekeul]

permet toi seulement!

[Godzestla]

Resalut,

il y a une faute dans mon code.

Voici la correction :

Code :

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

1
2
If wksSource.name <> wksDest.Name then

[tarmin]

Merci Zyhack ! La première partie du code fonctionne mais plus la suite, ou du moins pas comme je l'aimerais. Je m'explique, dans la feuil1 je saisie des chiffre. Mon code doit ensuite aller chercher dans les feuilles suivantes où ce trouve le chiffre et inscrire "new" dans la 3ème colonne sur la même ligne que le n° trouvé. Je vais creuser le truc de mon côté mais si vous avez une idée avant moi, c'est avec plaisir...

[zyhack]

tu avais écris

Mais maintenant je dois faire la même chose mise à part qu'il faut contrôler la saisie qui est fait sur la feuil2

si ta source est la feuille 1
il faut mettre

Code :

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

  Set wksSource = Sheets("Feuil1")

et ne pas traiter les feuilles préciser sur cette ligne j'ai remplacé Feuil2 par Feuil1 et à toi de voir s'il faut vérifier ou pas la feuil3 comme tu l'avais demandé précédemment.

Code :

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

    If wksDest.Name <> "Feuil1" And wksDest.Name <> "Feuil3" Then

Je te laisse tester ok

[tarmin]

Je me suis mal exprimé La partie de recherche fonctionne correctement et sur les bonnes feuilles. Le problème c'est que lorsqu'il cherche le n° dans une feuille et qu'il ne le trouve pas, il me l'inscrit à la fin et je ne comprend pas (encore...) pourquoi. Dans les feuilles où il ne trouve pas le n°, il ne doit rien faire, juste passer à la suivante...

[tarmin]

Voilà, j'ai trouvé le code qui fonctionne pour ce que je devais faire

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
Sub emp2()
  Dim wksSource As Worksheet
  Dim wksDest As Worksheet
  Dim rSource As Range
  Dim c As Range ' cellule source
  Dim d As Range ' cellule destination
  Dim i As Integer
 
  Set wksSource = Sheets("Feuil1")
  For Sheet_Number = 1 To Sheets.Count
    Set wksDest = Sheets(Sheet_Number)
       If wksDest.Name <> "Feuil1" And wksDest.Name <> "Récapitulatif" Then
  Set rSource = Range(wksSource.[A1], _
                      wksSource.Cells(wksSource.Cells.SpecialCells(xlLastCell).Row, 1))
 
  For Each c In rSource
    Set d = TrouveNumero(c.Value, wksDest)
      AjouteValeur c.Offset(0, i), d, i
  Next c
  End If
  Next
  End Sub
 
Function TrouveNumero(sValue As String, Wks As Worksheet) As Range
  Dim c As Range
  Set c = Wks.Columns(1).Find(What:=sValue, LookAt:=xlWhole, MatchCase:=False)
  If c Is Nothing Then
   End If
  Set TrouveNumero = c
End Function
 
Sub AjouteValeur(sValue As String, DestCell As Range, nCol As Integer)
nCol = 2
    If DestCell Is Nothing Then
    Exit Sub
    Else
  If IsEmpty(DestCell.Offset(0, nCol)) Then
    DestCell.Offset(0, nCol) = "new"
  Else
    MsgBox DestCell & " Déjà saisie", vbCritical
     If InStr(1, DestCell.Offset(0, nCol), sValue) = " " Then
      DestCell.Offset(0, nCol) = DestCell.Offset(0, nCol) & " "
    End If
    End If
    End If
End Sub

Je vais encore essayer d'ajouter un message qui me dis si le n° que j'ai saisie dans la feuil1 n'a pas été trouvé... Si quelqu'un a une idée...

[Godzestla]

Salut,

voici une proposition pour ton numéro non trouvé :

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
Sub emp2()
  Dim wksSource As Worksheet
  Dim wksDest As Worksheet
  Dim rSource As Range
  Dim c As Range ' cellule source
  Dim d As Range ' cellule destination
  Dim i As Integer
  Dim Found As Boolean
  
  Set wksSource = Sheets("Feuil1")
  For Sheet_Number = 1 To Sheets.Count
    Set wksDest = Sheets(Sheet_Number)
       If wksDest.Name <> "Feuil1" And wksDest.Name <> "Récapitulatif" Then
  Set rSource = Range(wksSource.[A1], _
                      wksSource.Cells(wksSource.Cells.SpecialCells(xlLastCell).Row, 1))
  Found = false
  For Each c In rSource
    Set d = TrouveNumero(c.Value, wksDest)
      AjouteValeur c.Offset(0, i), d, i
    If not d Is Nothing Then
       Found = True
    End If
    
  Next c
  if not found then
      msgbox ("Numéro "& c.Value & "non trouvé" , vbInformation)
  endif
  End If
  Next
  End Sub
 
Function TrouveNumero(sValue As String, Wks As Worksheet) As Range
  Dim c As Range
  Set c = Wks.Columns(1).Find(What:=sValue, LookAt:=xlWhole, MatchCase:=False)
  If c Is Nothing Then
   End If
  Set TrouveNumero = c
End Function
 
Sub AjouteValeur(sValue As String, DestCell As Range, nCol As Integer)
nCol = 2
    If DestCell Is Nothing Then
    Exit Sub
    Else
  If IsEmpty(DestCell.Offset(0, nCol)) Then
    DestCell.Offset(0, nCol) = "new"
  Else
      MsgBox DestCell & " Déjà saisie", vbCritical
     If InStr(1, DestCell.Offset(0, nCol), sValue) = " " Then
      DestCell.Offset(0, nCol) = DestCell.Offset(0, nCol) & " "
    End If
    End If
    End If
End Sub

[tarmin]

Merci pour la réponse ! Ca fonctionne mais ce n'est pas idéal. Ce qui serait bien c'est que le message vienne une fois que toutes les feuilles ont été testé et pas avant... Je ne sais pas si c'est possible ?
Merci d'avance

[Godzestla]

Et tu cherches combien de valeurs différentes ? Indéfini ?

Et tu veux 1 message unique avec toutes les valeurs non trouvées ?

[tarmin]

Je cherche en effet un nombre de valeur indéfini. Par contre je peux avoir un message pour chaque valeur qui n'a pas été trouvé ou un pour l'ensemble, c'est égale, mais après que ça ait bouclé sur toutes les feuilles... Je ne sais pas si c'est jouable...

[Godzestla]

C'est bien sur jouable mais ta logique n'est pas adpatée à cela :

il te faut pour cela :

Boucle 1

Code :

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

For Each c In rSource

Boucle 2

Code :

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

For Sheet_Number = 1 To Sheets.Count

ce qui permettrait de tester pour chaque C si on l'a trouvé dans une feuille ou pas et d'agir en fonction.

Je n'ai pas le temps de le changer pour toi. Fais le et je m'occupe du message après ?

Ok pour toi.

[tarmin]

Je comprend bien ce que tu veux dire mais par contre c'est pas certain que j'arrive à modifier mon code dans ce sens...

[Godzestla]

Salut,

essaie ceci (non testé)

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
 
Sub emp2()
  Dim wksSource As Worksheet
  Dim wksDest As Worksheet
  Dim rSource As Range
  Dim c As Range ' cellule source
  Dim d As Range ' cellule destination
  Dim i As Integer
  Dim Found As Boolean
  Dim missed() As Integer
  Dim i_mis      As Long
 
  Set wksSource = Sheets("Feuil1")
  Set rSource = Range(wksSource.[A1], _
                wksSource.Cells(wksSource.Cells.SpecialCells(xlLastCell).Row, 1))
  i_mis = 0
  For Each c In rSource
    Found = False
    For Sheet_number = 1 To Sheets.Count
        Set wksDest = Sheets(Sheet_number)
             If wksDest.Name <> "Feuil1" And wksDest.Name <> "Récapitulatif" Then
                Set d = TrouveNumero(c.value, wksDest)
                AjouteValeur c.Offset(0, i), d, i
                If Not d Is Nothing Then
                    Found = True
                End If
             End If
    Next Sheet_number
    If Not Found Then
       ReDim Preserve missed(i_mis To i_mis + 1)
       i_mis = i_mis + 1
       missed(i_mis) = c.value
    End If
  Next c
  For i = 1 To i_mis
   tutu = MsgBox("Numéro " & missed(i) & " non trouvé", vbInformation)
  Next i
  End Sub

[tarmin]

Quelle talent Merci beaucoup, ça à l'air de fonctionner !