VBA IF et COUNTIF...

Fchris

XLDnaute Occasionnel
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 :

Code:
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...
 
Dernière édition:

youky(BJ)

XLDnaute Barbatruc
Bonjour Fchris et à tous,
Essaie peut être comme ceci
Bruno
VB:
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
 

youky(BJ)

XLDnaute Barbatruc
Bon si tu as affaire toujours avec le même onglet
ceci à tester
Bruno
VB:
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

XLDnaute Occasionnel
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...
 

Fchris

XLDnaute Occasionnel
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):

VB:
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

XLDnaute Barbatruc
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
 
Dernière édition:

Fchris

XLDnaute Occasionnel
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

XLDnaute Barbatruc
Re Christophe

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

VB:
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
 

Lone-wolf

XLDnaute Barbatruc
Un exemple à adapter

VB:
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

XLDnaute Barbatruc
Re

Oubien comme ceci

VB:
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
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof