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
