Re : Matrice de saisie, références, maintien à jour automatique
Bonsoir,
Comme je n'avais rien compris, voici une macr VBA qui va mettre à jour la matrice :
Remarque : les listes A et B doivent être triées en croissant
Sub MaJ()
Dim L As Long, L2 As Long, C2 As Long, NbrLig As Long
' ajout des nouvelles lignes
NbrLIG_A = Worksheets("Entités A").Range("A65536").End(xlUp).Row
L2 = 2
L = 2
While L <= NbrLIG_A
If Worksheets("Entités A").Cells(L, 1).Value < Worksheets("Matrice A-B").Cells(L2, 1).Value _
And Worksheets("Matrice A-B").Cells(L2, 1).Value <> "" Then
'inserer une ligne
Worksheets("Matrice A-b").Rows(L2).Insert
Worksheets("Matrice A-b").Cells(L2, 1).Value = Worksheets("Entités A").Cells(L, 1).Value
L2 = L2 + 1
L = L + 1
ElseIf Worksheets("Entités A").Cells(L, 1).Value = Worksheets("Matrice A-B").Cells(L2, 1).Value Then
L2 = L2 + 1
L = L + 1
ElseIf Worksheets("Matrice A-B").Cells(L2, 1).Value = "" Then
'ajouter une ligne
Worksheets("Matrice A-b").Rows(L2).Insert
Worksheets("Matrice A-b").Cells(L2, 1).Value = Worksheets("Entités A").Cells(L, 1).Value
L2 = L2 + 1
L = L + 1
Else
While Worksheets("Entités A").Cells(L, 1).Value > Worksheets("Matrice A-B").Cells(L2, 1).Value
L2 = L2 + 1
Wend
End If
Wend
' ajout des nouvelles Colonnes
NbrCol_B = Worksheets("Entités B").Range("A65536").End(xlUp).Row
L2 = 2
L = 2
While L <= NbrLIG_A
If Worksheets("Entités A").Cells(L, 1).Value < Worksheets("Matrice A-B").Cells(L2, 1).Value _
And Worksheets("Matrice A-B").Cells(L2, 1).Value <> "" Then
'inserer une ligne
Worksheets("Matrice A-b").Rows(L2).Insert
Worksheets("Matrice A-b").Cells(L2, 1).Value = Worksheets("Entités A").Cells(L, 1).Value
L2 = L2 + 1
L = L + 1
ElseIf Worksheets("Entités A").Cells(L, 1).Value = Worksheets("Matrice A-B").Cells(L2, 1).Value Then
L2 = L2 + 1
L = L + 1
ElseIf Worksheets("Matrice A-B").Cells(L2, 1).Value = "" Then
'ajouter une ligne
Worksheets("Matrice A-b").Rows(L2).Insert
Worksheets("Matrice A-b").Cells(L2, 1).Value = Worksheets("Entités A").Cells(L, 1).Value
L2 = L2 + 1
L = L + 1
Else
While Worksheets("Entités A").Cells(L, 1).Value > Worksheets("Matrice A-B").Cells(L2, 1).Value
L2 = L2 + 1
Wend
End If
Wend
' ajout des nouvelles Colonnes
NbrLig = Worksheets("Entités B").Range("A65536").End(xlUp).Row
C2 = 2
L = 2
While L <= NbrLig
If Worksheets("Entités b").Cells(L, 1).Value < Worksheets("Matrice A-B").Cells(1, C2).Value _
And Worksheets("Matrice A-B").Cells(1, C2).Value <> "" Then
'inserer une ligne
Worksheets("Matrice A-b").Columns(C2).Insert
Worksheets("Matrice A-b").Cells(1, C2).Value = Worksheets("Entités B").Cells(L, 1).Value
C2 = C2 + 1
L = L + 1
ElseIf Worksheets("Entités B").Cells(L, 1).Value = Worksheets("Matrice A-B").Cells(1, C2).Value Then
C2 = C2 + 1
L = L + 1
ElseIf Worksheets("Matrice A-B").Cells(1, C2).Value = "" Then
'ajouter une ligne
Worksheets("Matrice A-b").Columns(C2).Insert
Worksheets("Matrice A-b").Cells(1, C2).Value = Worksheets("Entités B").Cells(L, 1).Value
C2 = C2 + 1
L = L + 1
Else
While Worksheets("Entités A").Cells(L, 1).Value > Worksheets("Matrice A-B").Cells(L2, 1).Value
L2 = L2 + 1
Wend
End If
Wend
MsgBox "Matrice mise à jour"
End Sub
il suffit d'inserer la macro via OUTILS/Macro/macro depuis créer et de recopier le code ci-dessus
bonne nuit
GIBI