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
| Sub test()
'lst_n = derniere ligne du tableau nouveaux
'lst_a = derniere ligne du tableau "ancien" dans feuille "Nouveau"
lst_n = Cells(3, 3).End(xlDown).Row
lst_a = Cells(3, 8).End(xlDown).Row
'a, b variables muettes d'initialisation
a = 0
b = 1
While a <> b And k < 2 ' k=nb sp -1 dans Nouveau
Sheets("Ancien").Select
'lst_lg = derniere ligne du tanbleau "Ancien"
lst_lg = Cells(6400, 2).End(xlUp).Row
'pour tous les nouveaux
For i = 0 To Sheets("Nouveau").Cells(3, 2).End(xlDown).Row - 3
Cells(2, 4).Select
'si nouveau n'est pas deja lie a ancien
If Sheets("Nouveau").Cells(3 + i, 8) = "" And Sheets("Nouveau").Cells(3 + i, 4 + k) <> "" Then
ligne = 0
'recherche sp(specialite) dans tableau ancien
On Error Resume Next
lg = Sheets("Ancien").Columns("D:D").Find(Sheets("Nouveau").Cells(3 + i, 4 + k)).Row
'Si sp nouveau n'existe pas dans le tableau ancien
If Err <> 0 Then
MsgBox "La specialite du nouveau de la ligne " & 3 + i & " n'existe pas dans le tableau des anciens"
Err.Clear
On Error GoTo 0
Exit Sub
Else
lg0 = lg
'si ancien PAS deja lie a un nouveau
If Sheets("Ancien").Cells(lg, 1) <> "X" Then
ligne = lg
Sheets("Ancien").Cells(ligne, 1) = "X"
Sheets("Nouveau").Cells(3 + i, 7) = Sheets("Ancien").Cells(ligne, 2)
Sheets("Nouveau").Cells(3 + i, 8) = Sheets("Ancien").Cells(ligne, 3)
Else
'cherche ancien suivant avec spe
l = 0
'conditions fin de recherche
While lg < lst_lg And ligne <> lg And (lg <> lg0 Or l = 0)
Sheets("Ancien").Cells(lg, 4).Select
lg = Columns("D:D").FindNext(After:=ActiveCell).Row
l = l + 1
'si ancien PAS deja parrain reporte dans feuille nouveau
If Sheets("Ancien").Cells(lg, 1) <> "X" Then
ligne = lg
Sheets("Nouveau").Cells(3 + i, 7) = Sheets("Ancien").Cells(ligne, 2)
Sheets("Nouveau").Cells(3 + i, 8) = Sheets("Ancien").Cells(ligne, 3)
Sheets("Ancien").Cells(ligne, 1) = "X"
End If
Wend
End If
End If
End If
Next
'=nb de nouveaau
'b =nb nouveaux rattaches a un ancien
a = WorksheetFunction.CountA(Sheets("Nouveau").Range("C3:C" & lst_n))
b = WorksheetFunction.CountA(Sheets("Nouveau").Range("H3:H" & lst_n))
k = k + 1
Wend
On Error GoTo 0
End Sub |
Partager