ID dans array pour condition
Bonjour à tous,
je récupère les id de projet rattachés à une personne via le code suivant
NomTableau = "Links14"
TblBD = Sheets("Investigators").ListObjects(NomTableau).DataBodyRange.Value
For i = 1 To UBound(TblBD)
If TblBD(i, 3) = PI_FirstName And TblBD(i, 4) = PI_Name Then
X = X + 1
ReDim Preserve piproject(1 To X)
piproject(X) = TblBD(i, 2)
End If
Next i
j'ai désormais besoin d'afficher les détails des projets dont l'id figure dans l'array piproject dans un tableau
Comment faire test que TblBD(I,1) est bien dans l'array en question dans ma condition ci dessous?
Dim Tbl()
For i = 1 To UBound(TblBD)
If TblBD(i, 13) = "Submitted" And Application.Match(TblBD(i, 1), piproject, True) Then
j'ai testé in_array qui ne fonctionne pas et tente désormais le match mais cela ne fonctionne pas non plus
une piste svp?
Merci par avance
@+
- Messages
- 4'086
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonjour,
Il me semble que vous vous compliquez un peu la vie. Une seule boucle me parait nécessaire, l'utilisation d'un tableau dynamique type dictionnaire serait plus simple. Par ailleurs, utiliser le code lié à un tableau structuré devrait vous éviter une "certaine gymnastique". Ci-dessous un exemple de code, d'après les données que vous avez fournies
Dim dic_projets As Object
Dim i As Long
Dim NomTableau As String, id_projet As Variant, état_projet As String, détail_projet As String
Dim tb_détail_1D()
NomTableau = "Links14"
Set dic_projets = CreateObject("Scripting.Dictionary")
With Range(NomTableau).ListObject
For i = 1 To .ListRows.Count
id_projet = .ListRows(i).Range.Columns("B")
état_projet = .ListRows(i).Range.Columns("M")
If .ListRows(i).Range.Columns("C") = PI_FirstName _
And .ListRows(i).Range.Columns("D") = PI_Name Then
If état_projet = "Submitted" Then
tb_détail_1D = Application.Transpose(Application.Transpose(.ListRows(i).Range.Columns("D:L").Value))
détail_projet = Join(tb_détail_1D, " ")
dic_projets(id_projet) = détail_projet
Else
dic_projets(id_projet) = "To be submitted"
End If
End If
Next i
je vous remercie pour votre retour Thev.
Cependant cela ne peut fonctionner comme cela pour la simple et bonne raison que les données proviennent de deux tableaux et onglets différents.
de plus j'ai besoin de pouvoir afficher cela dans un userform sous forme tableau comme l'indique la suite du code (voir ci-dessous)
j'ai donc bien besoin d'une deuxieme boucle mais ne sait comment la formuler pour la prise e compte de l'array
piproject
For i = 1 To UBound(TblBD)
If TblBD(i, 13) = "Submitted" And Application.Match(TblBD(i, 1), piproject, True) Then
Public Sub List_PI()
Dim FirstName, Name As String
Dim P_Inv As Worksheet
Dim piproject()
Set P_Inv = Sheets("Investigators")
'
NomTableau = "Links14"
TblBD = Sheets("Investigators").ListObjects(NomTableau).DataBodyRange.Value
For i = 1 To UBound(TblBD)
If TblBD(i, 3) = PI_FirstName And TblBD(i, 4) = PI_Name Then
x = x + 1
ReDim Preserve piproject(1 To x)
piproject(x) = TblBD(i, 2)
End If
Next i
'qui ensuite permettra de récupérer les informations projet et les renvoyer
' For j = 1 To UBound(piproject)
' MsgBox (piproject(j))
' Next
ColVisu = Array(1, 2, 3, 5, 6, 7, 9, 12, 10, 8)
LargeurCol = Array(1, 35, 80, 39, 45, 30, 50, 55, 30, 90)
NomTableau = "Projects"
TblBD = Range(NomTableau)
List_PI_Projects.ColumnCount = Range(NomTableau).Columns.Count - 5
List_PI_Projects.ColumnWidths = Join(LargeurCol, ";")
Dim Tbl()
For i = 1 To UBound(TblBD)
If TblBD(i, 13) = "Submitted" And Application.Match(TblBD(i, 1), piproject, True) Then
n = n + 1: ReDim Preserve Tbl(1 To UBound(TblBD, 2), 1 To n)
c = 0
For Each k In ColVisu
c = c + 1: Tbl(c, n) = TblBD(i, k)
Next k
End If
Next i
If n > 0 Then List_PI_Projects.Column = Tbl Else List_PI_Projects.Clear
End Sub
- Messages
- 4'086
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonjour,
Essayer ce code
Dim dic_projets_personne As Object, dic_projets_détails As Object
Dim i As Long, c As Integer
Dim NomTableau As String, id_projet As Variant, état_projet As String, détail_projet As String
Dim cell As Range
Dim colvisu(), tb_détails()
NomTableau = "Links14"
Set dic_projets_personne = CreateObject("Scripting.Dictionary")
With Range(NomTableau).ListObject
For i = 1 To .ListRows.Count
id_projet = .ListRows(i).Range.Columns("B")
If .ListRows(i).Range.Columns("C") = PI_FirstName _
And .ListRows(i).Range.Columns("D") = PI_Name Then
dic_projets_personne(id_projet) = id_projet
End If
Next i
End With
NomTableau = "Projects"
Set dic_projets_détails = CreateObject("Scripting.Dictionary")
colvisu = Array(1, 2, 3, 5, 6, 7, 9, 12, 10, 8): ReDim tb_détails(UBound(colvisu))
For Each id_projet In dic_projets_personne
With Range(NomTableau).ListObject
Set cell = .ListColumns(1).DataBodyRange.Find(id_projet)
If Not cell Is Nothing Then
i = cell.Row - .HeaderRowRange.Row
état_projet = .ListRows(i).Range.Columns("M")
If état_projet = "Submitted" Then
For c = 0 To UBound(colvisu)
tb_détails(c) = .ListRows(i).Range.Columns(colvisu(c))
Next c
dic_projets_détails(id_projet) = tb_détails
End If
End If
End With
Next id_projet
If dic_projets_détails.Count > 0 Then List_PI_Projects.Column = Application.Transpose(dic_projets_détails.items) _
Else List_PI_Projects.Clear
- Messages
- 4'086
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonjour,
Voir le nombre de colonnes de votre ListBox (ColumCount =10)
oui le nombre de colonne est bien de 1O ici
le ubound(colvisu) me renvoi bien cette valeur
For c = 0 To UBound(colvisu)
tb_détails(c) = .ListRows(i).Range.Columns(colvisu(c))
Next c
- Messages
- 4'086
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonjour,
il s'agit du nombre de colonnes de votre Listbox : List_PI_Projects
List_PI_Projects.ColumnCount = UBound(colvisu) + 1
If dic_projets_détails.Count > 0 Then List_PI_Projects.Column = Application.Transpose(dic_projets_détails.items) _
Else List_PI_Projects.Clear
exact merci à vous pour votre aide!