Comparer des arrays entre eux, les fusionner, ajouter des éléments dans un array

Vous pouvez télécharger le classeur fc-pap-arrays qui illustre les exemples présentés sur les pages pas à pas traitant des arrays

Attention, le code présenté dans ce tutoriel et dans le classeur exemple a été écrit et vérifié avec la version 2010 d'excel. Certaines propriétés peuvent ne pas fonctionner avec des versions antérieures, et avec les versions Mac d'excel antérieures à 2011.
Merci d'utiliser les commentaires pour poser des questions directement en rapport avec CE tutoriel EXCLUSIVEMENT et de poser les questions sur vos développements particuliers sur le forum microsoft answers excel.

Ajouter les donner d'un array dans un autre
Combiner deux arrays dans un nouvel array
Comparer deux arrays entre eux : valeurs communes, valeurs uniques

Fusionner deux arrays ou ajouter une valeur dans un array

On ne peut fusionner deux arrays en 1 seul que si

• les deux sont des arrays
• ils ont le même nombre de dimensions
• si ce sont des arrays à deux dimensions, ils ont le même nombre d'éléments dans leur première dimension.

Function ArrayPlus(ArrDep As Variant, Plus As Variant)
'ajoute l'array Plus à l'array ArrDep
'l'array d'arrivée est l'array de départ redimensionné et avec les nouveaux éléments

Dim a As Integer
Dim t As Integer
Dim i As Integer, j As Integer, k As Integer
Dim X As Variant
Dim ut As Integer, at As Integer, mt As Integer

'on teste si ArrDep et Plus sont des arrays, si ce n'est pas le cas, on crée un array
'à une dimension contenant la valeur de la variable come seul élément
If Not IsArray(ArrDep) Then
    X = ArrDep
    ReDim ArrDep(1 To 1)
    ArrDep(1) = X
End If

If Not IsArray(Plus) Then
    X = Plus
    ReDim Plus(1 To 1)
    Plus(1) = X
End If

t = NombreDim(ArrDep)
If t = 2 Then ut = UBound(ArrDep, 1): mt = UBound(ArrDep, 2)
If t = 1 Then mt = UBound(ArrDep, 1)
a = NombreDim(Plus)
If a = 2 Then at = UBound(Plus, 1)
If (t > 2 Or a > 2) Then MsgBox ("cette fonction en gère pas les arrays de dimensions supérieure à 2")

If t - a <> 0 Then
    MsgBox ("Les deux arrays doivent avoir le même nombre de dimensions")
    Exit Function
Else
    If t = 1 Then
        k = 1
        ReDim Preserve ArrDep(1 To UBound(ArrDep) + UBound(Plus))
        For i = mt + 1 To UBound(ArrDep)
            ArrDep(i) = Plus(k)
            k = k + 1
        Next i
    Else
    
    'le nombre de colonnes doit être le même dans les deux array
    If ut <> at Then _
        MsgBox ("les nombre d'éléments dans la première dimension doit être identique dans les deux arrays")
    
        k = 1
        ReDim Preserve ArrDep(1 To UBound(ArrDep, 1), 1 To UBound(ArrDep, 2) + UBound(Plus, 2))
        For i = 1 To UBound(ArrDep, 1) 'la première dimension ne varie pas elle contient 3 valeurs dans l'exemple
            For j = mt + 1 To UBound(ArrDep, 2)
                ArrDep(i, j) = Plus(i, k)
                a = k + 1
            Next j
            k = 1
        Next i
    
    End If
End If
ArrayPlus = ArrDep
End Function

La variante ci-dessous, au lieu de redimensionner l'array de départ pour y ajouter des données, créé un nouvel array :

Function ArrayPlusNew(ArrDep As Variant, Plus As Variant)
'ajoute l'array Plus à l'array ArrDep
'l'array d'arrivée est un nouvel Array

Dim ArrFinal
Dim a As Integer
Dim t As Integer
Dim i As Integer, j As Integer, k As Integer
Dim X As Variant
Dim ut As Integer, at As Integer

If Not IsArray(ArrDep) Then
    X = ArrDep
    ReDim ArrDep(1 To 1)
    ArrDep(1) = X
End If

If Not IsArray(Plus) Then
    X = Plus
    ReDim Plus(1 To 1)
    Plus(1) = X
End If

t = NombreDim(ArrDep)
If t = 2 Then ut = UBound(ArrDep, 1)
a = NombreDim(Plus)
If a = 2 Then at = UBound(Plus, 1)
If (t > 2 Or a > 2) Then MsgBox ("cette fonction en gère pas les arrays de dimensions supérieure à 2")

If t - a <> 0 Then
    MsgBox ("Les deux arrays doivent avoir le même nombre de dimensions")
    Exit Function
Else
    If t = 1 Then
        k = 1
        ReDim ArrFinal(1 To UBound(ArrDep) + UBound(Plus))
        For i = 1 To UBound(ArrDep)
            ArrFinal(i) = ArrDep(i)
        Next i
        For i = UBound(ArrDep) + 1 To UBound(ArrFinal)
            ArrFinal(i) = Plus(k)
            k = k + 1
        Next i
    Else
   
    'le nombre de colonnes doit être le même dans les deux arrays
    If ut <> at Then _
        MsgBox ("le nombre d'éléments dans la première dimension doit être identique dans les deux arrays")
   
        k = 1
        ReDim ArrFinal(1 To UBound(ArrDep, 1), 1 To UBound(ArrDep, 2) + UBound(Plus, 2))
        For i = 1 To UBound(ArrDep, 1) 'la première dimension ne varie pas elle contient 3 valeurs dans l'exemple
            For j = 1 To UBound(ArrDep, 2)
                ArrFinal(i, j) = ArrDep(i, j)
            Next j
            For j = UBound(ArrDep, 2) + 1 To UBound(ArrFinal, 2)
                ArrFinal(i, j) = Plus(i, k)
                k = k + 1
            Next j
            k = 1
        Next i
   
    End If
End If
ArrayPlusNew = ArrFinal
End Function

Exemple (simpliste !) d'utilisation : comment regrouper dans un seul array les données contenues dans deux plages d'une feuille. En partant de deux plages de 4 lignes x 3 colonnes pour l'une et 4 lignes x 4 colonnes, on crée un array de 4 lignes x 7 colonnes que l'on copie dans la feuille.

Sub FusionEnColonnes()
Dim Tblo1, Tblo2, Tblo3
With Sheets("ex6-plus")
    Tblo1 = .Range("A4:C7").Value
    Tblo2 = .Range("F4:I7").Value
    Tblo3 = ArrayPlusNew(Tblo1, Tblo2)
   .Range("A10").Resize(UBound(Tblo1, 1), UBound(Tblo1, 2) + UBound(Tblo2, 2)) = Tblo3
End With
End Sub

Attention : il faut garder en mémoire qu'on ne peut redimensionner dans un array que la deuxième dimension. Donc si on veut maintenant partir d'une plage de 7 lignes x 3 colonnes et d'une autre de 4 lignes et 3 colonnes, pour utiliser la fonction ArrayPlusNew ci-dessus, il faut entrer les données dans les array en les transposant, faire la fusion des deux arrays puis retransposer le résultat pour le coller dans la feuille :

Sub FusionEnLignes()
Dim Tblo1, Tblo2, Tblo3
With Sheets("ex6-plus")
    Tblo1 = Application.WorksheetFunction.Transpose(.Range("A17:C23").Value)
    Tblo2 = Application.WorksheetFunction.Transpose(.Range("E17:G20").Value)
    Tblo3 = ArrayPlusNew(Tblo1, Tblo2)
    .Range("A27").Resize(UBound(Tblo1, 2) + UBound(Tblo2, 2), UBound(Tblo1, 1)) = _
    Application.WorksheetFunction.Transpose(Tblo3)
End With
End Sub

Comparer deux arrays

Cette macro compare deux arrays (ici deux arrays à 2 dimensions) et liste les valeurs communes aux deux (lignes et colonnes confondues), celles qui sont uniquement dans le premier array et celles qui sont uniquement dans le second.

Sub ArrayDiff()
Dim Tblo1() As Variant, Tblo2() As Variant
Dim i As Integer, j As Integer
Dim Communs
Dim UnicT1
Dim UnicT2
Dim elt As Variant
Dim c As Integer, u1 As Integer, u2 As Integer

ReDim Tblo1(1 To 30, 1 To 3)
ReDim Tblo2(1 To 30, 1 To 3)
ReDim UnicT1(0 To 0)
ReDim UnicT2(0 To 0)
ReDim Communs(0 To 0)

For i = 1 To 30
    For j = 1 To 3
        Tblo1(i, j) = 3 * i + j
        Tblo2(i, j) = 3 * i - j
    Next j
Next i

With Sheets("test")
.Range("C1:E30") = Tblo1
.Range("G1:I30") = Tblo2
End With

c = 1
u1 = 1
u2 = 1

For Each elt In Tblo1
    If IsInArray2D(elt, Tblo2()) Then
        ReDim Preserve Communs(1 To c)
        Communs(c) = elt
        c = c + 1
    Else
        ReDim Preserve UnicT1(1 To u1)
        UnicT1(u1) = elt
        u1 = u1 + 1
    End If
Next elt

For Each elt In Tblo2
    If Not IsInArray2D(elt, Tblo1) Then
        ReDim Preserve UnicT2(1 To u2)
        UnicT2(u2) = elt
        u2 = u2 + 1
    End If
Next elt

With Sheets("test")
.Range("K1").Resize(UBound(Communs)) = Application.WorksheetFunction.Transpose(Communs)
.Range("L1").Resize(UBound(UnicT1)) = Application.WorksheetFunction.Transpose(UnicT1)
.Range("M1").Resize(UBound(UnicT2)) = Application.WorksheetFunction.Transpose(UnicT2)
End With

End Sub