Match et countif probleme

Le 28/08/2020 à 16:32

Bonjour à tous,

je rencontre deux soucis que je pense lié que je n'arrive pas à expliquer

en effet

soucis 1:

PRange = Application.Match(id_projet, Worksheets("Reporting").Range("A:A"), 0)

je cherche par exemple l'id_projet 10 qui est bien reconnu mais inexistant dans ma base et il me sort des periods tout de même.

pourtant je cherche bien dans l'onglet Reporting en colonne A.

ma formule est elle incorrecte?

soucis 2

si je prends un autre exemple d'id projet 32 j'ai 5 périodes associées dans ma base

pourtant la condition s'effectue comme si nb_period est égal à 6...

If (nb_period >= "6") Then

auriez vous une idée où je bugue?

merci

With Worksheets("Reporting")
On Error Resume Next

PRange = Application.Match(id_projet, .Range("A:A"), 0)
nb_period = Application.WorksheetFunction.CountIf(Worksheets("Reporting").Range("A:A"), id_projet)

If (nb_period >= "1") Then
Start_Period_1 = .Range("A:G")(PRange, 5)
End_Period_1 = .Range("A:G")(PRange, 7)
End If
If (nb_period >= "2") Then
Start_Period_2 = .Range("A:G")(PRange + 1, 5)
End_Period_2 = .Range("A:G")(PRange + 1, 7)
End If
If (nb_period >= "3") Then
Start_Period_3 = .Range("A:G")(PRange + 2, 5)
End_Period_3 = .Range("A:G")(PRange + 2, 7)
End If
If (nb_period >= "4") Then
Start_Period_4 = .Range("A:G")(PRange + 3, 5)
End_Period_4 = .Range("A:G")(PRange + 3, 7)
End If
If (nb_period >= "5") Then
Start_Period_5 = .Range("A:G")(PRange + 4, 5)
End_Period_5 = .Range("A:G")(PRange + 4, 7)
End If
If (nb_period >= "6") Then
Start_Period_6 = .Range("A:G")(PRange + 5, 5)
End_Period_6 = .Range("A:G")(PRange + 5, 7)
End If

End With
Le 28/08/2020 à 17:15

bonjour,

j'enlèverais les guillemets dans les tests numériques

nb_period >= "1"

j'enlèverais aussi le on error resume next, tant que je suis en phase de mise au point.

Le 28/08/2020 à 18:45

bonjour

j'ai tenté mais cela ne résoud hélas pas le soucis

n'y a t'il pas une erreur de codage dans mes formules?

PRange = Application.Match(id_projet, Worksheets("Reporting").Range("A:A"), 0)
nb_period = Application.WorksheetFunction.CountIf(Worksheets("Reporting").Range("A:A"), id_projet)

merci par avance

Le 28/08/2020 à 19:37

merci de nous mettre ton fichier ou un fichier exemple dans lequel tu as pu reproduire le problème.

Le 28/08/2020 à 21:08

Bonjour,

Normalement, ton premier problème est dû à une erreur de syntaxe. Il vaut saisir worksheetfunction.match. Peut-être que ça varie suivant les versions mais ça ne m'a jamais posé de problème de la sorte.

Ensuite, il ne faut pas que id_projet soit de type range mais je ne crois pas que ce soit le cas.

Pour le second problème, on ne comprend pas bien où tu veux en venir mais il semble qu'il y ait une logique qui découle de ton code qui puisse s'obtenir plus facilement, au moyen d'une boucle.

Pouvez-vous essayez ainsi :

Option base 1

Sub Maprocedure()

Dim id_projet '???
Dim PRange as long
Dim nb_period as byte, i as byte
Dim Start_Period(), End_Period()

With Worksheets("Reporting")

PRange = WorksheetFunction.Match(id_projet, .Range("A:A"), 0)
nb_period = WorksheetFunction.CountIf(Worksheets("Reporting").Range("A:A"), id_projet)

Redim Start_Period(nb_period)
Redim End_Period(nb_period)

for i = 1 to nb_period
    Start_Period(i) = .cells(PRange + i - 1, 5).value
    End_Period(i) = .cells(PRange + i - 1, 7).value
next i

End With

end sub

Je tiens à préciser que ça ne renverra rien mais vous pourrez voir si les tableaux start et end sont correctement affectés. Ensuite vous pourrez agir sur ces tableaux pour aboutir au résultat escompté.

Cordialement,

Le 29/08/2020 à 17:49

Bonjour,

Je vous remercie pour votre code.

Celui-ci ne génère effectivement aucune erreur.

comment verifier toutefois que les tableaux start et end sont correctement affectés?

merci

si tout hasard cela ne fonctionnait pas je tenterais de préparer un fichier retraçant le soucis

Le 29/08/2020 à 18:46

Bonjour,

Et bien par exemple en rajoutant un petit Msgbox en avant dernière ligne du code et en marquant un point d'arrêt sur cette ligne. Ensuite, vous regardez vos variables locales (dans la fenêtre variables locales disponible via le menu Affichage) pour en consulter les valeurs.

Cordialement,

Le 29/08/2020 à 19:36

Bonjour …

Avec le fichier joint (code adapté)

Private Sub Voir_Click()
  Dim id_projet
  Dim L As Long, i As Byte
  Dim n As Byte
  Dim Start_Period(), End_Period()
  id_projet = "B1"
  On Error GoTo 1                                 'si absent en colonne A !
  L = Application.Match(id_projet, [A:A], 0)
  n = Application.CountIf([A:A], id_projet)
  ReDim Start_Period(n)
  ReDim End_Period(n)
  [H2:I100].Clear 'si visuel demandé
  For i = 1 To n
    Start_Period(i) = Cells(L + i - 1, 5).Value
       Cells(i + 1, 8) = Start_Period(i)         'pour voir
    End_Period(i) = Cells(L + i - 1, 7).Value
       Cells(i + 1, 9) = End_Period(i)           'pour voir
  Next
1
End Sub

Nota : le seul intérêt de WorksheetFunction. est d’avoir la liste des choix, encore faut-il savoir traduire les mots en français (Match = ??? )

Le 30/08/2020 à 07:28

Oups, ce serait mieux avec un fichier exemple :

11exemple-code-adapte.xlsm (21.37 Ko)
Le 30/08/2020 à 13:53

Bonjour,

Une proposition.

Cdlt.

8exemple-code-adapte.xlsm (23.53 Ko)
Private Sub Voir_Click()
Dim tbl, arr(), id_projet, L, n As Double, I As Long, k As Long

    id_projet = "B1"

    With Me
        On Error Resume Next
        L = Application.Match(id_projet, .Columns(1), 0)
        If Not IsError(L) Then
            tbl = .Range("A2:G" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
            n = WorksheetFunction.CountIf(.Columns(1), id_projet)
            ReDim arr(1 To n, 1 To 2)
            For I = 1 To UBound(tbl)
                If tbl(I, 1) = id_projet Then
                    k = k + 1
                    arr(k, 1) = tbl(I, 5)
                    arr(k, 2) = tbl(I, 7)
                End If
            Next I
            .Cells(2, 8).Resize(n, 2).Value = arr
        Else
            Err.Clear
            MsgBox "id_projet est inconnu !...", 64, "Information"
        End If
    End With

End Sub
Le 31/08/2020 à 08:40

Bonjour à tous ,

Je vous remercie pour vos retours, codes et commentaires.
je vais examiner tout cela et tenter de le mettre en place.

Merci

Le 31/08/2020 à 10:53

Re,

J'ai tenté les deux possibilités de codage mais dans les deux cas ne voit pas comment l'afficher dans mon array dico :(

    Set dic_statuts = CreateObject("Scripting.Dictionary")
    Set tb_projects = [Projects].ListObject
    With tb_projects
        For i = 0 To .ListRows.Count
            id_projet = .ListColumns("Id_Project").DataBodyRange.Rows(i)
            Acronym = .ListColumns("Acronym").DataBodyRange.Rows(i)
            CallFrame = .ListColumns("Call_Frame").DataBodyRange.Rows(i)
            début = .ListColumns("Start_Date").DataBodyRange.Rows(i)
            fin = .ListColumns("End_Date").DataBodyRange.Rows(i)
            Duration = .ListColumns("Duration").DataBodyRange.Rows(i)
            statut = .ListColumns("Status").DataBodyRange.Rows(i)

 With Worksheets("Reporting")
    L = Application.Match(id_projet, [A:A], 0)
    n = Application.CountIf([A:A], id_projet)
    ReDim Start_Period(n)
    ReDim End_Period(n)
    For j = 1 To n
        Start_Period(j) = Cells(L + j - 1, 5).Value
            'Cells(i + 1, 8) = Start_Period(i)           'pour voir
        End_Period(j) = Cells(L + j - 1, 7).Value
            'Cells(i + 1, 9) = End_Period(i)             'pour voir
              Next
End With

             If (statut = "Active") Then
            If Not dic_statuts.exists(statut) Then Set dic_statuts(statut) = CreateObject("Scripting.Dictionary")
            Set dic_projects = dic_statuts(statut)
            dic_projects(id_projet) = Array(statut, Acronym, CallFrame, début, fin, Duration, Investigator_firstname, Investigator_name, CLng(Budget_Requested), Start_Period1, End_Period1, Start_Period2, End_Period2, Start_Period3, End_Period3, Start_Period4, End_Period4, Start_Period5, End_Period(5), Start_Period(6), End_Period6)
            Set dic_statuts(statut) = dic_projects

            End If
        Next i
    End With

C'est ici que je dois déclarer les valeurs à afficher (j'ai enlever une partie du code pour l'alléger donc toutes les variables ci-dessous ne sont pas forcement afficher au dessus!

dic_projects(id_projet) = Array(statut, Acronym, CallFrame, début, fin, Duration, Investigator_firstname, Investigator_name, CLng(Budget_Requested))

comment déclarer après

CLng(Budget_Requested)

les Start_Period 1 et End_Period 1 par exemple?

merci par avance,

Le 31/08/2020 à 14:12

j'ai essayé avec

  dic_projects(id_projet) = Array(statut, Acronym, CallFrame, début, fin, Duration, Investigator_firstname, Investigator_name, CLng(Budget_Requested), arr(1, 1), arr(1, 2), arr(2, 1), arr(2, 2), arr(3, 1), arr(3, 2), arr(4, 1), arr(4, 2), arr(5, 1), arr(5, 2), arr(6, 1), arr(6, 2))

avec le proposé par Jean-Eric mais cela ne retourne rien.

Dim tb_projects As ListObject
    Dim dic_statuts As Object, dic_projects As Object
    Dim i As Integer
    Dim PI_interne As String, début As Variant, fin As Variant, commentaire As String, statut As String, chemin As String, fichier As String
    Dim id_projet As Variant, clé As Variant
    Dim wb As Workbook

    Set dic_statuts = CreateObject("Scripting.Dictionary")
    Set tb_projects = [Projects].ListObject
    With tb_projects
        For i = 0 To .ListRows.Count
            id_projet = .ListColumns("Id_Project").DataBodyRange.Rows(i)
            Acronym = .ListColumns("Acronym").DataBodyRange.Rows(i)
            CallFrame = .ListColumns("Call_Frame").DataBodyRange.Rows(i)
            début = .ListColumns("Start_Date").DataBodyRange.Rows(i)
            fin = .ListColumns("End_Date").DataBodyRange.Rows(i)
            Duration = .ListColumns("Duration").DataBodyRange.Rows(i)
            statut = .ListColumns("Status").DataBodyRange.Rows(i)

       With Worksheets("Reporting")
        On Error Resume Next
        L = Application.Match(id_projet, .Columns(1), 0)
        If Not IsError(L) Then
            Tbl = .Range("A2:G" & .Range("A" & .Rows.Count).End(xlUp).row).Value
            n = WorksheetFunction.CountIf(.Columns(1), id_projet)
            ReDim arr(1 To n, 1 To 2)
            For j = 1 To UBound(Tbl)
                If Tbl(j, 1) = id_projet Then
                    k = k + 1
                    arr(k, 1) = Tbl(j, 5)
                    arr(k, 2) = Tbl(j, 7)
                End If
            Next j
            '.Cells(2, 8).Resize(n, 2).Value = arr
'        Else
'            Err.Clear
'            MsgBox "id_projet est inconnu !...", 64, "Information"

        End If
    End With

             If (statut = "Active") Then
            If Not dic_statuts.exists(statut) Then Set dic_statuts(statut) = CreateObject("Scripting.Dictionary")
            Set dic_projects = dic_statuts(statut)
            dic_projects(id_projet) = Array(statut, Acronym, CallFrame, début, fin, Duration, Investigator_firstname, Investigator_name, CLng(Budget_Requested), arr(1, 1), arr(1, 2), arr(2, 1), arr(2, 2), arr(3, 1), arr(3, 2), arr(4, 1), arr(4, 2), arr(5, 1), arr(5, 2), arr(6, 1), arr(6, 2))
            Set dic_statuts(statut) = dic_projects

            End If
        Next i
    End With
Le 31/08/2020 à 22:01

Bonjour,

J'ai des difficultés à suivre !...

Commence par répondre aux intervenants qui ont tenté de répondre à ta question initiale, avant de formuler une nouvelle demande qui à priori n'a rien à voir avec cette dernière.

Cdlt.

Le 31/08/2020 à 23:33

Bonsoir,

C'est vrai qu'avant tout, il aurait mieux valu tester le code de Jean-Eric pour s'assurer des valeurs renvoyées.

Pour le reste, pour ma part, je n'y connais rien donc impossible de juger de la bonne utilisation du dictionnaire. Toutefois, en mettant de côté les éventuelles fautes de syntaxe, le bon sens serait d'adapter tel que suit :

dic_projects(id_projet) = Array(statut, Acronym, CallFrame, début, fin, Duration, Investigator_firstname, Investigator_name, CLng(Budget_Requested), Start_period, End_Period)

'ou suivant l'option retenue

dic_projects(id_projet) = Array(statut, Acronym, CallFrame, début, fin, Duration, Investigator_firstname, Investigator_name, CLng(Budget_Requested), arr)

Maintenant, est-ce la bonne façon d'affecter un dictionnaire ? Je ne sais pas

Cdlt,

Le 01/09/2020 à 12:29

Bonjour,

Bon je pense que j'aurais du commencer par là mais bon çà prenait du temps..

j'ai mis une base exemple comprenant les données et qui via le script génère le fichier Tbd_Projets

En espérant à clarifier mon soucis initial et actuel le tout restant lié

9base-exemple.xlsm (35.01 Ko)
7tbd-projets.xlsm (9.94 Ko)

j'ai enlevé les parties relatives aux autres onglets qui fonctionne cependant

les données relative aux projets sont bien exportées dans le tbd projets mais c'est donc bien les périodes qui me pose soucis.

je souhaite pouvoir exporter en ligne les périodes relative à chaque projet ce qui était le problème initiale avec le problème de match et countif revu par vos boucles plus pro

Cependant et pour faire suite

la boucle semble fonctionner quand je tente via msgbox

exemple avec MsgBox arr(1, 1) mais cependant ne fonctionne qu'au deuxeime affichage

or j = 1 To UBound(Tbl)
                If Tbl(j, 1) = id_projet Then
                    k = k + 1
                    arr(k, 1) = Tbl(j, 5)
                    arr(k, 2) = Tbl(j, 7)
                End If
            Next j

mais je ne sais pas au delà de boucle comment indiquer la résultante propre par projet dans dic_projets

    If (statut = "Active") Then
            If Not dic_statuts.exists(statut) Then Set dic_statuts(statut) = CreateObject("Scripting.Dictionary")
            Set dic_projects = dic_statuts(statut)
            dic_projects(id_projet) = Array(statut, Acronym, CallFrame, début, fin, Duration, Investigator_firstname, Investigator_name, CLng(Budget_Requested))
            Set dic_statuts(statut) = dic_projects

            End If

exemple pour projet 1 dans base exemple cela devrait me retourner

Début P1Fin P1Début P2Fin P2Début P3Fin P3Début P4Fin P4Début P5Fin P5Début P6Fin P6
01/01/202030/06/202101/07/202131/12/202201/01/202331/12/202301/01/202431/12/2024

car dans base:

1Periodic Report : Period 1101/01/20201830/06/2021
2Periodic Report: Period 21901/07/20213631/12/2022
3Periodic Report : Period 33701/01/20234831/12/2023
4Periodic Report : Period 44901/01/20246031/12/2024

En espérant que j'ai cette fois été assez claire sur mon soucis et que vous pourrez et voudriez bien m'assister

Merci grandement à vous

bonne journée

Rechercher des sujets similaires à "match countif probleme"