Déterminer nbre d'éléments contenus dans variable tableau

cathodique

XLDnaute Barbatruc
Bonsoir,

Pour extraire des données d'une BD, suivant certaines conditions j'utilise des variables tableaux (Tb et RES). Je voudrais connaitre le nombre d'éléments contenus dans la variable pour rajouter une condition pour la poursuite de la procédure.
Si nombre lignes < 50, sortir de la procédure, sinon poursuivre éxecution.
Code:
Sub Consulter()

Dim o As Object
Dim LastLig As Long
Dim BD As Object
Dim Tb, RES()
Dim Val As String, Val1 As String
Dim DerCol As Integer
Dim i As Long, j As Long, ligne As Long
Dim Plage As Range
'===========================================
Set BD = Sheets("BD") 'définit l'onglet bd
Dl = BD.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit derlg col1 onglet bd
Set o = Sheets("MaFeuille")

Application.EnableEvents = False
Application.ScreenUpdating = False
'===========================================
On Error Resume Next
Application.DisplayAlerts = False

'Dans la variable tableau Tb on récupère toutes les données de la feuille BD
With BD                 'Worksheets("BD")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Tb = .Range("A2:AA" & LastLig)
End With

With o              'Worksheets("MaFeuille")
DerCol = o.Range("A7").End(xlToRight).Column
     Val1 = .Range("C1").Value    'date
     Val = .Range("F3").Value     'cp
    'on parcours le tableau Tb et si la ligne correspond aux 3 critères
    For i = 1 To LastLig - 1
        '
        If Tb(i, 3) = Val1 And Tb(i, 18) = Val Then
                            'on incrémente le compteur j (nombre de lignes trouvées)
            j = j + 1
            'On redimensionne notre tableau Resultat (12 lignes et j colonnes) Res sera transposé à la fin
            'car on ne peut redimenssionner que la dernière dimension
            ReDim Preserve RES(1 To 10, 1 To j)
            'Le compteur est inscrit en 1ère ligne
            RES(1, j) = "=ROW()-7"
            'on fait une petite boucle
            RES(2, j) = Tb(i, 1)
            RES(3, j) = Tb(i, 4)
            RES(4, j) = Tb(i, 19) & Chr(10) & Tb(i, 23) & Chr(10) & Tb(i, 22)
            RES(5, j) = Tb(i, 20)
            RES(6, j) = Tb(i, 21)
            RES(7, j) = Tb(i, 9)
            RES(8, j) = Tb(i, 15)
            RES(9, j) = Tb(i, 16)
            RES(10, j) = Tb(i, 17)
        End If
    Next i
    'on efface la plage de Calcul
    LastLig = o.Cells(.Rows.Count, 1).End(xlUp).Row
    If LastLig > 7 Then .Range("A8:J" & LastLig).Clear 'Contents
    'on transfère le transposé de Res
    If j > 0 Then .Range("A8").Resize(j, 10) = Application.Transpose(RES)
              
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
        
Application.Goto Range("A1"), True
  
 MsgBox "Etat Prêt!", vbInformation
    End Sub


En vous remerciant beaucoup.

Cordialement,
 
Dernière édition:

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
314 644
Messages
2 111 528
Membres
111 189
dernier inscrit
Laurent.