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 |
Partager