VBA IF et COUNTIF...

[Fchris]

Bonjour à toutes et tous,

Un petit souci que je n'arrive pas à résoudre.

J'ai la formule suivante :
=SI(NB.SI('Liste TR'!$A$3:$A$67;A2)>0;"X";"")

que je n'arrive pas à traduire en VBA. J'ai écrit le code suivant :

Sheets("TR").Select
der = Range("A1048576").End(xlUp).Row

    For z = 2 To der

        If Application.WorksheetFunction.CountIf(Sheets("Liste TR").Range("A3:A") _
        & Sheets("Liste TR").Range("A" & Rows.Count).End(xlUp).Row, Cells(z, 1)) > 0 Then
        Cells(z, 5).Value = "X"
        End If
    Next z

mais j'ai systématiquement une erreur "erreur définie par l'application ou par l'objet".

C'est très certainement un truc tout bête mais cela m'échappe complètement.

Merci par avance de vos éclairages...

 

[youky(BJ)]

Bonjour Fchris et à tous,
Essaie peut être comme ceci
Bruno

der = Sheets("Liste TR").Range("A1048576").End(xlUp).Row
    For z = 2 To der
        If Application.CountIf(Sheets("Liste TR").Range("A3:A" & der), Cells(z, 1)) > 0 Then
         Cells(z, 5).Value = "X"
        End If
    Next z

 

[Fchris]

Bonjour Bruno,

Merci de ta réponse

Je viens de tester mais toujours la même erreur...

 

[youky(BJ)]

Bon si tu as affaire toujours avec le même onglet
ceci à tester
Bruno

With Sheets("Liste TR")
' un point va indiquer à quel onglet on fait référence
der = .Range("A1048576").End(xlUp).Row
    For Z = 2 To der
        If Application.CountIf(.Range("A3:A" & der), .Cells(Z, 1)) > 0 Then
         .Cells(Z, 5).Value = "X"
        End If
    Next Z
End With

Sans fichier test pas toujours évident

 

[Fchris]

Merci Bruno.

J'ai essayé de faire un fichier test, mais pas évident car c'est une infime partie d'un gros traitement.

J'ai séparé les deux onglets concernés ainsi que le code correspondant. La partie bloquante se situe à la fin.

En espérant que cela soit plus parlant...

 

[youky(BJ)]

Le fichier a un MP pour le code VBA
Je vois qu'il contient des données confidentiels
il serait bon de supprimer ce fichier du forum>Edit>suppr le fichier
Envoie simplement le code entier de la macro
Bruno

 

[Fchris]

Ok Bruno, merci

Voici le code complet (tu ne pourras pas l'exécuter car il l'a déjà été, sauf la partie qui coince):

Sub Trest()
Dim z As Integer
Dim der As Variant
Dim ListTR As Workbook


WKVAC = ActiveWorkbook.Name

Sheets("TR").Activate
der = Range("A1048576").End(xlUp).Row

Application.ScreenUpdating = False

'Suppression des non droits
    For z = der To 2 Step -1
    If Not (Cells(z, 7).Value > 1) Then Rows(z).Delete
    Next z

'suppression des doublons
    Range("A1:G" & Sheets("TR").Range("A1048576").End(xlUp).Row).RemoveDuplicates Columns:=Array(1, 5), Header:=xlYes
 
' Attribuer 1 sur chaque jour
   For z = 2 To Range("A1048576").End(xlUp).Row
   Cells(z, 7).Value = 1
   Next z

                                                ' Additionner les TR par matricules

' supprimer les doublons de matricules
    Range("A1:C" & Range("A" & Rows.Count).End(xlUp).Row).Copy
    Range("J1").Select
    ActiveSheet.Paste
    ActiveSheet.Range("J1:L" & Sheets("TR").Range("J" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlYes
 
'compter le nombre de TR par matricule
der = Range("J1048576").End(xlUp).Row
Range("M1").Value = "Nbre TR"
 
    For z = 2 To der
    Cells(z, 13).Value = Application.WorksheetFunction.SumIf(Range("A2:A" & Sheets("TR").Range("A" & Rows.Count).End(xlUp).Row), _
    Cells(z, 10), Range("G2:G" & Sheets("TR").Range("G" & Rows.Count).End(xlUp).Row))
    Next z

Columns("A:I").Delete
Range("A1").Select

Application.ScreenUpdating = True
MsgBox ("Ouverture du fichier pour TR...")

'Ouverture de la source TR
Set ListTR = Application.Workbooks.Open(Application.GetOpenFilename(), local:=True)

Application.ScreenUpdating = False
'Copie des données
    Cells.Select
    Selection.Copy
    Workbooks(WKVAC).Activate
    Workbooks(WKVAC).Sheets.Add after:=Sheets("TR")
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveSheet.Name = "Liste TR"

[B]' c'est ici que ça coince...    [/B]
Sheets("TR").Select
der = Range("A1048576").End(xlUp).Row

    For z = 2 To der

        If Application.WorksheetFunction.CountIf(Sheets("Liste TR").Range("A3:A") _
        & Sheets("Liste TR").Range("A" & Rows.Count).End(xlUp).Row, Cells(z, 1)) > 0 Then
        Cells(z, 5).Value = "X"
        End If
    Next z
       

Application.ScreenUpdating = True
End Sub

 

[Lone-wolf]

Bonsoir tout le monde 🙂

Christophe il faut écrire comme ceci der = Range("a" & Rows.Count).End(xlUp).Row, si dans la formule la ligne s'arrête à 67, inutile de mettre A1048576. Et

Sheets("TR").Activate
With Activesheet
If WorksheetFunction.CountIf(.Range("A3:A" & derlig)........ Then
End With

 

[youky(BJ)]

Bien vu Jacky j'avais pas remarqué........

 

[Fchris]

Bonsoir Lone-wolf,

Merci de ta réponse. Je viens de tester mais cela ne fonctionne pas non plus...

Toujours le même code erreur "erreur définie par l'application ou par l'objet".

J'ai l'impression que ce n'est pas tant dans ma sélection de plage que dans l'utilisation de la fonction que cela bloque.

Je fais une recherche de la dernière ligne car la plage est variable et va augmenter avec le temps. Elle n'est pas figée à 67 lignes...

Christophe

 

[Lone-wolf]

Re Bruno

Au faite, tu peux m'appeler Dodo (abbrégé d'un certain prénom) 😉

 

[Lone-wolf]

Re Christophe

Un essai comme ceci peut-être; et der et z ne doivent pas être déclarés variant mais long.

Sheets("TR").Activate
With Activesheet
der = .Range("a" & Rows.Count).End(xlUp).Row
For z = 2 To der
If WorksheetFunction.CountIf(.Range("A2:A" & derlig), .Cells(z, 1)) > 0 Then .Cells(z, 5).Value = "X"
Next z
End With

 

[Fchris]

Non désolé, toujours pas : propriété ou méthode non gérée par cet objet...

 

[Lone-wolf]

Un exemple à adapter

Option Explicit

Private Sub CommandButton1_Click()
Dim derlig As Long,  i As Long

  With Sheets("BASE")
  derlig = .Range("e" & Rows.Count).End(xlUp).Row

  For i = 5 To 10
  Range("d" & i) = Application.SumIf(.Range("e3:e" & derlig), Range("c" & i), .Range("g3:g" & derlig))
  Range("f" & i) = Application.CountIfs(.Range("c3:c" & derlig), Range("h" & i), .Range("e3:e" & derlig), Range("c" & i))
  Range("g" & i) = Application.CountIfs(.Range("c3:c" & derlig), Range("i" & i), .Range("e3:e" & derlig), Range("c" & i))
  Next i
  End With
End Sub

 

[Lone-wolf]

Re

Oubien comme ceci

Option Explicit
Sub Test()
Dim derlig&, z&, y&

    derlig = Range("a" & Rows.Count).End(xlUp).Row
    For y = 2 To derlig
        If WorksheetFunction.CountIf(Range("a2:a" & derlig), Cells(y, 1).Row) > 0 Then
            z = z + 1
        End If
        Cells(2, 3) = z
    Next y
End Sub

'OU ENCORE COMME CECI
Option Explicit
Sub Test()
Dim derlig&, i&

  derlig = Range("a" & Rows.Count).End(xlUp).Row
  For i = 2 To derlig
  If Cells(i, 1) > 0 Then Cells(i, 3) = "x"
  End If
  Next i
End Sub