Sub MàJ_Suivi_TVA()
Dim ResF, ResP, ResV, Tmp, MaDim As Long, nbDim As Integer, NbLgn As Long, Sz As Long, i As Long, j As Long
Dim LO As ListObject
MaDim = 0
'COLLECTE DES DONNEES
'TVA perçue
Tb = Sh_Facturé.[tb_Facturé].Value2 'données dans le tableau tb
Sz = UBound(Tb, 1)
ReDim Test(1 To Sz, 1 To 1)
For i = 1 To Sz: Test(i, 1) = Not IsEmpty(Tb(i, 10)): Next 'tableau logique pour la fonction filter (date réception non vide)
Tmp = WorksheetFunction.Filter(Tb, Test, "NA")
'type de résultat du filtre
If IsArray(Tmp) Then
MaDim = UBound(Tmp, 1)
nbDim = -1: On Error Resume Next: nbDim = UBound(Tmp, 2): On Error GoTo 0
'1) à une dimension (1 seule ligne filtrée), conversion en tableau à 2 dimensions
If nbDim = -1 Then
ReDim ResF(1 To 1, 1 To MaDim)
For i = 1 To MaDim: ResF(1, i) = Tmp(i): Next
NbLgn = NbLgn + 1 'Total des lignes filtrées
Else
'2) à deux dimensions (Plusieurs lignes filtrées)
ResF = Tmp
NbLgn = NbLgn + MaDim 'Total des lignes filtrées
End If
Else
'3) Aucun résultats (résultat= "NA")
ResF = Tmp
End If
'TVA payée
Tb = Sh_Payé.[tb_Payé].Value2 'données dans le tableau tb
Sz = UBound(Tb, 1)
ReDim Test(1 To Sz, 1 To 1)
For i = 1 To Sz: Test(i, 1) = Not IsEmpty(Tb(i, 1)): Next 'tableau logique pour la fonction filter (date de paiement non vide)
Tmp = WorksheetFunction.Filter(Tb, Test, "NA")
'type de résultat du filtre
If IsArray(Tmp) Then
MaDim = UBound(Tmp, 1)
nbDim = -1: On Error Resume Next: nbDim = UBound(Tmp, 2)
'1) à une dimension (1 seule ligne filtrée), conversion en tableau à 2 dimensions
If nbDim = -1 Then
ReDim ResP(1 To 1, 1 To MaDim)
For i = 1 To MaDim: ResP(1, i) = Tmp(i): Next
NbLgn = NbLgn + 1 'Total des lignes filtrées
Else
'2) à deux dimensions (Plusieurs lignes filtrées)
ResP = Tmp
NbLgn = NbLgn + MaDim 'Total des lignes filtrées
End If
Else
'3) Aucun résultats (résultat= "NA")
ResP = Tmp
End If
'TVA versée
Tb = Sh_Suivi.[tb_Suivi_TVA].Value2 'données dans le tableau tb
Sz = UBound(Tb, 1)
ReDim Test(1 To Sz, 1 To 1)
For i = 1 To Sz: Test(i, 1) = Not IsEmpty(Tb(i, 3)): Next 'tableau logique pour la fonction filter (acompte non vide)
Tmp = WorksheetFunction.Filter(Tb, Test, "NA")
'type de résultat du filtre
If IsArray(Tmp) Then
MaDim = UBound(Tmp, 1)
nbDim = -1: On Error Resume Next: nbDim = UBound(Tmp, 2)
'1) à une dimension (1 seule ligne filtrée), conversion en tableau à 2 dimensions
If nbDim = -1 Then
ReDim ResV(1 To 1, 1 To MaDim)
For i = 1 To MaDim: ResV(1, i) = Tmp(i): Next
NbLgn = NbLgn + 1
Else
'2) à deux dimensions (Plusieurs lignes filtrées)
ResV = Tmp
NbLgn = NbLgn + MaDim
End If
Else
'3) Aucun résultats (résultat= "NA")
ResV = Tmp
End If
'MISE A JOUR DU TABLEAU RECAPITULATIF
'redimensionner le tableau structuré
Set LO = Sh_Suivi.ListObjects("tb_Suivi_TVA")
Sh_Suivi.[tb_Suivi_TVA].ClearContents
Select Case NbLgn
Case 0
LO.Resize LO.HeaderRowRange.Resize(2)
Exit Sub
Case 1
LO.Resize LO.HeaderRowRange.Resize(2)
Case Is > 1
LO.Resize LO.HeaderRowRange.Resize(NbLgn + 1)
End Select
'Concaténation des lignes filtrées
ReDim Résult(1 To NbLgn, 1 To 5)
If IsArray(ResF) Then
j = 0
For i = 1 To UBound(ResF)
j = j + 1
Résult(j, 1) = ResF(i, 10) 'La date de réception (en colonne 10)
Résult(j, 2) = ResF(i, 5) 'Le montant de la TVA perçue (en colonne 5)
Résult(j, 5) = ResF(i, 11) 'La référence (en colonne 11)
Next
End If
If IsArray(ResP) Then
For i = 1 To UBound(ResP)
j = j + 1
Résult(j, 1) = ResP(i, 1) 'La date de paiement (en colonne 1)
Résult(j, 4) = ResP(i, 4) 'Le montant de la TVA payée (en colonne 4)
Résult(j, 5) = ResP(i, 6) 'La référence (en colonne 6)
Next
End If
If IsArray(ResV) Then
For i = 1 To UBound(ResV)
j = j + 1
Résult(j, 1) = ResV(i, 1) 'La date de versement (en colonne 1)
Résult(j, 3) = ResV(i, 3) 'Le montant de l'accompte (en colonne 3)
Résult(j, 5) = ResV(i, 5) 'La référence (en colonne 5)
Next
End If
'Remplissage du tableau structuré après tri sur la colonne 1 (des dates)
Sh_Suivi.[tb_Suivi_TVA] = WorksheetFunction.Sort(Résult, 1, -1)
End Sub