[VBA] Ajouter une plage à une variable tableau (à la suite du tableau)

Function TableUnique(ParamArray TP() As Variant) As Variant()
Rem. —— Renvoie un tableau unique où sont empilés l'un derrière l'autre plusieurs tableaux de
'       diverses sources. La seconde dimension des différents tableaux doit commencer à 1.
'       Cependant dans le tableau résultant elle commencera à 0, l'élément 0 restituant le
'       numéro d'ordre de la source, commençant à 0 pour la 1ère.
CréerTableUnique TableUnique, TP
End Function
Property Let TableauÀAjouter(ByVal Quoi)
Rem. —— Ajoute un tableau à une liste de ceux qui devraont être empilés et renvoyés en un
'       seul par la fonction TableUniqueCréée.
Dim NMax As Long
On Error Resume Next: NMax = UBound(TDon): On Error GoTo 0
NMax = NMax + 1: ReDim Preserve TDon(1 To NMax): TDon(NMax) = Quoi
End Property
Function TableUniqueCréée(Optional ByVal CRSrc As Long = 0) As Variant()
Rem. —— Renvoie un tableau unique où sont empilés l'un derrière l'autre plusieurs tableaux de
'       diverses sources.
'       CRSrc : N° colonne supplémentaire de repérage de la source. Facultatif: 0 assumé.
'       La seconde dimension des différents tableaux doit commencer à 1.
'       Cependant dans le tableau résultant elle pourra commencer à 0, si CRSrc est
'       spécifié à 0 ou non spécifié. La colonne CRSrc recevra le numéro d'ordre
'       de la source, la première étant LBound(TP).
CréerTableUnique TableUniqueCréée, TDon, CRSrc
Erase TDon
End Function
Sub CréerTableUnique(TCbl(), ByVal TP As Variant, Optional ByVal CRSrc As Long = 0)
Rem. —— Crée un tableau unique où sont empilés l'un derrière l'autre plusieurs tableaux de
'       diverses sources.
'       TCbl: Le tableau à créer
'       TP  : La liste des tableaux ou des plages à prendre en compte.
'             Il s'agit d'un tableau à une dimension contenu dans un Variant donc.
'       CRSrc : N° colonne supplémentaire de repérage de la source. Facultatif: 0 assumé.
'       La seconde dimension des différents tableaux doit commencer à 1.
'       Cependant dans le tableau résultant elle pourra commencer à 0, si CRSrc est
'       spécifié à 0 ou non spécifié. La colonne CRSrc recevra le numéro d'ordre
'       de la source, la première étant LBound(TP).
Dim P As Long, Lr As Long, C As Long, CMin As Long, CMax As Long, TSrc(), Le As Long
If CRSrc >= 1 Then CMin = 1: CMax = CRSrc
For P = LBound(TP) To UBound(TP)
   Select Case TypeName(TP(P))
   Case "Range":     Lr = Lr + TP(P).Rows.Count:                        C = TP(P).Columns.Count
   Case "Variant()": Lr = Lr + UBound(TP(P), 1) + 1 - LBound(TP(P), 1): C = UBound(TP(P), 2)
   Case "Variant":   Lr = Lr + 1:                                       C = 1
   Case Else: C = 0: End Select
   If CMin + (C < CRSrc) + C > CMax Then CMax = CMin + (C < CRSrc) + C
   Next P
If Lr < 1 Then TCbl = Array(): Exit Sub
ReDim TCbl(1 To Lr, CMin To CMax): Lr = 0
For P = LBound(TP) To UBound(TP)
   Select Case TypeName(TP(P))
   Case "Range":
      If TP(P).Rows.Count = 1 And TP(P).Columns.Count = 1 Then
         ReDim TSrc(1 To 1, 1 To 1): TSrc(1, 1) = TP(P).Value
         Else: TSrc = TP(P).Value: End If
   Case "Variant()": TSrc = TP(P)
   Case "Variant": ReDim TSrc(1 To 1, 1 To 1): TSrc(1, 1) = TP(P)
   Case Else: TSrc = Array(): End Select
   For Le = LBound(TSrc, 1) To UBound(TSrc, 1): Lr = Lr + 1: TCbl(Lr, CRSrc) = P
      For C = 1 To UBound(TSrc, 2): TCbl(Lr, CMin + (C < CRSrc) + C) = TSrc(Le, C): Next C, Le, P
End Sub

CréerTableUnique MonTab, Array([A1:B10], [A30:B34]), 3

Sub essaiMergeTbl()
  a = [A1:B10].Value
  b = [A30:B34].Value
  c = MergeTbl(a, b)
  [D1].Resize(UBound(c), UBound(c, 2)) = c
End Sub

Sub essai()
  Set Rng = [A1:B34]
  Dim tmp(1 To 15, 1 To 1)
  For i = 1 To 10: tmp(i, 1) = i: Next i
  For i = 30 To 34: tmp(i - 19, 1) = i: Next i
  Tbl = Application.Index(Rng, tmp, Array(1, 2))
  [M1].Resize(UBound(Tbl), UBound(Tbl, 2)) = Tbl
End Sub

Function Fusionner_N_Tables(ParamArray ListTables())
Dim r(), i&
  If LBound(ListTables) > UBound(ListTables) Then
    Fusionner_N_Tables = Empty
  ElseIf LBound(ListTables) = UBound(ListTables) Then
    Fusionner_N_Tables = ListTables(LBound(ListTables))
  Else
    r = Fusionner_2_Tables(ListTables(LBound(ListTables)), ListTables(LBound(ListTables) + 1))
    For i = LBound(ListTables) + 2 To UBound(ListTables)
      r = Fusionner_2_Tables(r, ListTables(i))
    Next i
    Fusionner_N_Tables = r
  End If
End Function

Function Fusionner_2_Tables(ByVal a, ByVal b)
Dim r(), Li&, Co&, i&, i1&, i2&, j&, j1&, j2&, k&, aux
  If IsEmpty(a) Then
    Fusionner_2_Tables = b
    Exit Function
  ElseIf IsEmpty(b) Then
    Fusionner_2_Tables = a
    Exit Function
  End If
  
  If Not IsArray(a) Then
    aux = a
    ReDim a(1 To 1, 1 To 1)
    a(1, 1) = aux
  End If
  
  If Not IsArray(b) Then
    aux = b
    ReDim b(1 To 1, 1 To 1)
    b(1, 1) = aux
  End If
  
  Li = UBound(a) - LBound(a) + 1 + UBound(b) - LBound(b) + 1
  Co = UBound(a, 2) - LBound(a, 2) + 1
  If UBound(b, 2) - LBound(b, 2) + 1 > Co Then Co = UBound(b, 2) - LBound(b, 2) + 1
  ReDim r(1 To Li, 1 To Co)
  
  i1 = LBound(a): i2 = UBound(a): j1 = LBound(a, 2): j2 = UBound(a, 2)
  For i = i1 To i2
  k = k + 1
    For j = j1 To j2
      r(k, j) = a(i, j)
    Next j
  Next i
  
  i1 = LBound(b): i2 = UBound(b): j1 = LBound(b, 2): j2 = UBound(b, 2)
  For i = i1 To i2
    k = k + 1:
    For j = j1 To j2
      r(k, j) = b(i, j)
    Next j
  Next i
  
  Fusionner_2_Tables = r
End Function