Doute sur ma méthode

Version imprimable

bjr au forum
j'ai "pillé" le site pour m'aider à faire mes macros, un grand merci.
maintenant, j'ai un doute sur une de mes macros:
2 feuilles 5 & 3
- je lis les noms de la feuille 5 pour chercher une correspondance sur la 3
-pas de correspondance = exit
- correspondance: contrôle que le prénom soit le même
- le même = copier une cellule de feuille 3, col I sur feuille 5
- pas le même: ....(hum) je descend d'une ligne..... = doute

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
Sub concordance()
    'vérif si un autre animal a été adopté pour mêmes nom & prénom
Dim i, L, b As Integer, A, N, P
    'L = ligne concordance, N = nom et P = prénom adoptant
With Sheets(5)  'Adoptants_Animaux_†
    For i = 2 To .Cells(100, 2).End(xlUp).Row   '2 à B100
        N = .Cells(i, 2) 'N = nom adoptant
        P = .Cells(i, 3) 'P = prénom adoptant
        On Error Resume Next
'recherche ligne concordance sur Adoptants_Animaux (3)
        L = WorksheetFunction.Match(N, Workbooks("adoptions.xls").Worksheets(3).Range("B1:B500"), 0)
            If Not L = 0 Then
                If Sheets(3).Cells(L, 3) = P Then
                A = Sheets(3).Cells(L, 9)  'colonne I
                Sheets(5).Cells(i, 14) = "a aussi adopté " & A
                    Else
                    L = L + 1       'DOUTEUX !
                    If Sheets(3).Cells(L, 3) = P Then
                    A = Sheets(3).Cells(L, 9)  'colonne I
                    Sheets(5).Cells(i, 14) = "a aussi adopté " & A  'Adoptants_Animaux_†
                    End If
                End If
            End If
        L = 0
        Next i
End With
End Sub

17/08/2013, 12h04
casefayere

je vois quelques incohérences, peux-tu envoyer un fichier exemple (sans vraies données, bien sur), j'ai commencé à travailler mais j'ai besoin d'une base qui me permette de comprendre
17/08/2013, 12h42
leronce

1 pièce(s) jointe(s)

j'ai oublié de spécifier qu'elle fonctionne bien avec les données actuelles

voilà le fichier nettoyé

Citation:

j'ai oublié de spécifier qu'elle fonctionne bien avec les données actuelles

Juste pour voir une autre solution, regardes ce code établi sur la base de ton exemple dans lequel aucun nom ne correspondait donc j'en ai adapté quelques uns

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub concordance()
'vérif si un autre animal a été adopté pour mêmes nom & prénom
Dim x As Integer, y As Integer, verif3 As String, verif5 As String
Dim Dl As Long, S3 As Worksheet, S5 As Worksheet
Dim Tb3, Tb5 'j'ai pris l'habitude de passer par des variables "tableau"
Set S3 = Sheets("Adopt_Animaux = 480")
Set S5 = Sheets("Animaux_† = 40")
Dl = S5.Range("B" & S5.Rows.Count).End(xlUp).Row
Tb5 = S5.Range("B2:M" & Dl)
Dl = S3.Range("B" & S3.Rows.Count).End(xlUp).Row
Tb3 = S3.Range("B2:I" & Dl) 'si les feuilles sont structurées de la même façon
For x = 1 To UBound(Tb3, 1)
  verif3 = Tb3(x, 1) & Tb3(x, 2)
  For y = 1 To UBound(Tb5, 1)
    verif5 = Tb5(y, 1) & Tb5(y, 2)
    If verif3 = verif5 Then
      Tb5(y, 12) = "a aussi adopté " & Tb3(x, 8)
    End If
  Next y
Next x
S5.Range("B2").Resize(UBound(Tb5, 1), UBound(Tb5, 2)) = Tb5
 
End Sub

17/08/2013, 13h40
leronce

je viens d'essayer:
c'est la feuille 5 qui regarde sur la 3, j'ai inversé
un hic, au lieu d'avoir 18 concordances, 1 seule est trouvée et fausse
je vais me faire la main avec "tableaux", comprendre ta macro ...
merci
17/08/2013, 13h48
casefayere

si tu veux que je renvoie la macro avec les explications détaillées, dis-le

Citation:

c'est la feuille 5 qui regarde sur la 3, j'ai inversé

je préfèrerais que tu appelles les feuilles par leur nom afin d'être explicite car dans l'exemple envoyé, aucune feuille n'est "Sheets(3)" ou "Sheets(5)" ni d'ailleurs "Feuil(3)" ou "Feuil(5)"
17/08/2013, 13h58
leronce

pour les explications, avec plaisir
le nombre dans le nom des feuilles changent pour informer les autres bénévoles
donc
feuille(5) : Animaux_† = 40
feuille(3) : Adopt_Animaux = 480
raison pour laquelle, dans toutes les macros, je travaille avec sheets(1 ou 2 etc)

J'ai donc inversé la recherche

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
Sub concordance()
Dim x As Integer, y As Integer, verif3 As String, verif5 As String
Dim Dl As Long, S3 As Worksheet, S5 As Worksheet
Dim Tb3, Tb5 'j'ai pris l'habitude de passer par des variables "tableau" pour la rapidité d'éxcution
Set S3 = Sheets("Adopt_Animaux = 480") 'variable représentant la feuille
Set S5 = Sheets("Animaux_† = 40") 'variable représentant la feuille
Dl = S5.Range("B" & S5.Rows.Count).End(xlUp).Row 'on cherche la derniere ligne renseignée dans la feuille
Tb5 = S5.Range("B2:M" & Dl) ' tb5 contient les données de S5, soit "Animaux_† = 40"
Dl = S3.Range("B" & S3.Rows.Count).End(xlUp).Row 'on cherche la derniere ligne renseignée dans la feuille
Tb3 = S3.Range("B2:I" & Dl) ' tb3 contient les données de S3, soit "Adopt_Animaux = 480"
For x = 1 To UBound(Tb5, 1) 'une boucle qui parcoure Tb5
  verif5 = Tb5(x, 1) & Tb5(x, 2) 'verif5 contient donc, au début de boucle valeur de _
  B2 & C2 de S5
  For y = 1 To UBound(Tb3, 1) 'une boucle qui parcoure Tb3
    verif3 = Tb3(y, 1) & Tb3(y, 2) 'verif5 contient donc, au début de boucle valeur de _
  B2 & C2 de S3
    If verif3 = verif5 Then 'si les valeurs correspondent
      Tb3(y, 8) = "a aussi adopté " & Tb5(x, 12) 'on donne la valeur à la 8ème colonne de Tb3 quisera affectée _
      par la suite à la col I, I est la 9ème col mais le tableau commence en B => de B à I 8 colonnes
    End If
  Next y
Next x
S3.Range("B2").Resize(UBound(Tb3, 1), UBound(Tb3, 2)) = Tb3 'on affecte le résultat du tableau à la feuille "Adopt_Animaux = 480" _
en redimensionnant avec "Resize
 
End Sub

Je vais être obligé de partir, je ne pourrai plus répondre avant Demain, alors j'espère que tu pourras comprendre et adapter cette proposition

17/08/2013, 14h22
leronce

merci pour tout
bon we à toi, ainsi qu'au forum

donc la ligne 17 de ta 1ère proposition est juste, mais ne renvoie rien

Code:

Tb5(y, 12) = "a aussi adopté " & Tb3(x, 8)

il faut remplacer Tb5(y,12) par Cells(y,12)

Code:

Cells(x, 12) = "a aussi adopté " & Tb3(y, 8)

super nickel