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.
En vous remerciant beaucoup.
Cordialement,
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: