VBA, compter le nombre de ligne non masquée Résolu/Fermé

Question

Bonjour,

Je voudrais compter le nombre de ligne non masquée et ensuite afficher le resultat

MERCIIIIIIIIIIIIIIIIIIIII

Private Sub CommandButton3_Click()

Dim R As Long
Dim c As Integer

With Application.WorksheetFunction
If c.EntireRow.hiden = False Then
R = .CountA(Range("A3:A100"))
MsgBox ("il y a " & R & " cellules non vides dans la colonne A")

End With

End Sub

gbinforme · Accepted Answer

bonjour

Comme ceci cela devrait mieux fonctionner

Private Sub CommandButton3_Click() 
Dim R As Double
Dim l As Double
For l = 1 To Cells(65536, 1).End(xlUp).Row
    If Not Rows(l).Hidden Then R = R + 1
Next l
MsgBox ("il y a " & R & " lignes visibles dans la colonne A")
End Sub

Ce sont les lignes visibles qui sont comptées et pas les cellules non vides..

rhalimi13 · Answer

merci bcp de ta solution,

je vais la travailler parceque je suis débutant en vba


MERCIIIIIIIIIII ENCOREEEE

rhalimi13 · Answer

Franchement ta solution marche mieux que le programme que m'a été remis sur un forum
le tiens ne me compte que les visible, ca c excellent!!

si j'ai un autre pb, tu pourras m'aider?

thanks

gbinforme · Answer

bonjour

Merci de ton message et c'est tout de même normal de fournir du code qui correspond au besoin ?

si j'ai un autre pb, tu pourras m'aider?

Pas de problème mais bientôt c'est toi qui va aider les autres !

rhalimi13 · Answer

Bonjour, 

je reviens vers toi, esperant ne pas trop t'en demander
 
voila j'ai un souci avec inputBox, lorsque je click sur annuler ou si je ne saisi rien a inputbox, VBA active le debogueur, 
je souhaiterais qu'il ferme la inputbox si j'annule, 

tu peux voir, MEEEERCI




Private Sub CommandButton2_Click()

Range("a1:I30").Interior.ColorIndex = xlNone

Dim msg As Double
  
  msg = InputBox("quelle est la moyenne glissante? ")
  
  
  'If msg = "" Then Exit Sub
  
'Dim msg
'msg = InputBox
  'If msg = vbCancel Then
  'Exit Sub
  'End If
  
Dim c As Range

   For Each c In ActiveSheet.Range("a1:I30")
   
    If c < msg And c <> "" Then
        c.Interior.Color = RGB(168, 168, 168)
    End If
    
Next

End Sub

gbinforme · Answer

bonjour

Je te propose de gérer ainsi l'annulation :
On Error Resume Next        ' si erreur on passe à la ligne suivante
msg = InputBox("quelle est la moyenne glissante? ")

If msg = 0 Then Exit Sub    ' si "Annuler" est utilisé on sort de la macro
On Error GoTo 0             ' le contrôle erreur est remis en fonction

Tu peux aussi le faire en changeant ta réservation
Dim msg As Variant

 msg = InputBox("quelle est la moyenne glissante? ")

If msg = "" Then Exit Sub    ' si "Annuler" est utilisé on sort de la macro

rhalimi13 · Answer

re

j'ai testé ce que tu m'a donné, mais je rencontre tjs des soucis, soit il lance le débeugage ou il m'affiche 2 fois la inputbox

mon exercice est de colorier des cellules inf a x%

merci de ton aide

gbinforme · Answer

bonjour

Je t'ai fourni 2 possibilités : tu choisis l'une ou l'autre, pas les deux.

Le plus simple est de passer "msg" en variant.

rhalimi13 · Answer

re bonjour

j'ai mis msg comme variant, au niveau de la inputbox ca marche nickel, par contre il ne me respecte plus la condition et me colories toutes les cellules, il cherche pas a comprendre,

merci

gbinforme · Answer

bonjour

Avec ceci, cela devrait mieux fonctionner.
For Each c In ActiveSheet.Range("a1:I30")

If c < Val(msg) And c <> "" Then
        c.Interior.Color = RGB(168, 168, 168)
Else
        c.Interior.Color = xlNone
End If

Next

Lorsque tu saisis une valeur dans inputbox, c'est du texte et donc il faut le traduire en numérique pour comparer.
Dans les formules excel le fait parfois mais pas en VBA.

Il est plus prudent aussi de décolorer si l'on ne rempli pas la condition.

rhalimi13 · Answer

Bonjour, je vien de faire le test avec 

          Val( msg)     et    On Error Resume Next, CA MARCHE NICKEL !! PERFECT

donc 'val', comme tu m'a expliqué, traduit le texte en numérique (vue que c de l'inputBox, c'est cela si je ne me trompe pas)

et le 'On Error Resume Next', permet de passer à la ligne suivante si l'utilisateur se trompe et saisie du Texte ( par erreur de frappe)


par contre pas besoin du else, sinon dans la boucle il me colorie toute la plage de travail apres avoir réalisé la condition

autrement on m'a proposé ca;If ((CDec(c.Value) < CDec(msg)) And (CStr(c.Value) <> "")) Then, je ne sais commt ce que ca veut dire et en faisant du copie coller, ca ne marché pas

Je n'ai plus qu'a te remercier et te dire à bientôt

Bonne journée !

rhalimi13 · Answer

bonjour, encore moi

j'ai ce code qui fonctionne, mais je souhaiterais lui dire d'aller de 2 jusqu'a la fin du tableau, sans définir la dernierre cellule (ici=15)
comment je fais?


Private Sub CommandButton1_Click()
Dim var As Integer
var = 2
For var = 2 To 15
If Cells(var, 2) > 100 Then
Range(Cells(var, 1), Cells(var, 2)).Font.Bold = True
End If
Next
End Sub

gbinforme · Answer

bonjour

Avec un autre type de boucle peut-être
Private Sub CommandButton1_Click()
Dim var As Integer
var = 2
Do While Cells(var, 1) <> ""
    If Cells(var, 2) > 100 Then
        Range(Cells(var, 1), Cells(var, 2)).Font.Bold = True
    End If
    var = var + 1
Loop
End Sub

Tu fais progresser ton indice ligne et tu t'arrêtes si la cellule est vide : à adapter avec ton tableau !

rhalimi13 · Answer

salut mon ami

de retour 

je voudrais sil te plais
 
convertir une date (jj/mm/année) en semaine correspondant


merci

gbinforme · Answer

bonjour

Avec l'année en A1, cette formule est plus efficace que la fonction NO.SEMAINE qui n'est pas fiable en Europe du moins.
=ENT(MOD(ENT((A1-2)/7)+0,6;52+5/28))+1

rhalimi13 · Answer

Bonjour,

eh bien merci merci et Merci !!

parceque j'ai passé toute la soirée hier , de 17h à 23h (bien sur pas en continue) et je n'ai rien trouvé ds google

bien !!

est ce que tu peux me dire comment tu l'as trouvé que je puisse améliorer mes connaissance en info;

merci encore

etr passe une bonne journée!

a bientôt

rhalimi13 · Answer

bonjour, tu peux m'aider sil te plais j'aurais souhaiter colorier les cellules suivant le contenu de la cellule dans la colonne b ma plage de donnée est : "c2;l27", et mes condition sont sur la collone B j'ai realisé un code mais il ne marche pas voici: Private Sub CommandButton1_Click() Dim c As Range Dim var As Integer var = 2 For Each c In ActiveSheet.Range("c2:l27") If c <> "" And Cells(var, 2) = mp Then c.Interior.ColorIndex = 4 End If var = var + 1 Next If c <> "" And Cells(var, 2) = mc Then c.Interior.ColorIndex = 3 End If var = var + 1 If c <> "" And Cells(var, 2) = df Then c.Interior.ColorIndex = 1 End If var = var + 1 End Sub

gbinforme · Answer

bonjour Si j'ai compris... Private Sub CommandButton1_Click() Dim c As Range Dim var As Integer var = 2 For Each c In ActiveSheet.Range("c2:l27") If c <> "" And Cells(c.row, var) = mp Then c.Interior.ColorIndex = 4 End If Next If c <> "" And Cells(c.row, var) = mc Then c.Interior.ColorIndex = 3 End If If c <> "" And Cells(c.row, var) = df Then c.Interior.ColorIndex = 1 End If End Sub

rhalimi13 · Answer

franchement, tu m'as repondus, je suis tt content!!

oui c ca, en fait je veux colorier mes cellules dans la plage ( Range("c2:l27") ) suivant le contenu des cellules de la colonne b2

j'ai recupéré ton code mais ca bloque,

sil te plais aide moi, merrrrrrcciciiiiii

comment je peux t'envoyer le fichier excel autrement

rhalimi71 · Answer

si tu as besoin de plus d'explication je suis connecté, merrci
parceque le code que m'as posté me semble tres correct, mais pourquoi il ne reponds pas?

gbinforme · Answer

bonjour

Il faut des guillemets si c'est une valeur que tu testes mais je pensais que c'était des variables ou des constantes définies et alors pas de guillemet.

gbinforme · Answer

bonjour

Faudrait peut-être mettre ta zone index ligne en "long" sinon tu auras des souci avec les gros fichiers (>32000)

Faudrait aussi définir sur quelle feuille tu veux travailler, sauf si tu l'as fait en variables publiques.
Il faut aussi que tu fasse la boucle sur chaque fichier.
Private Sub CommandButton1_Click()
Dim i As long
Dim j As long
Dim Feuil as worksheet
Dim Feuil2 as worksheet
set Feuil = worsheets(....)
set Feuil2 = worsheets(....)
For i = 3 To 1500
  for j = 2 to Feuil.Cells(65536, 5).end(xlup).row
     If Feuil2.Cells(i, 2).Value = Feuil.Cells(j, 5).Value Then
        Feuil.Cells(i, 5).Interior.ColorIndex = 4
     End If
  next j
Next i
End Sub

rhalimi13 · Answer

bonjour,

une question; le contenu qui se trouve entre parenthese est le nom de mes 2 fichiers excel comme ci-dessous?
car j'ai 2 fichiers et je compare colonne x du fichier1 / à la colonne y du fichier 2

Set Feuil = worsheets(encour_x007E_1.xls)  ?
set Feuil2 = worsheets(1500_mode_op_meca.xls)   ?


merci;

cordialement,

gbinforme · Answer

bonjour

non en fait il faut faire un peu plus compliqué car il faut tenir compte des workbooks, c'est-à-dire des classeurs.

Tu n'as plus qu'à changer le nom de tes feuilles et la copie devrait fonctionner et elle rajoute à ce qui existe sur ta feuille.
Private Sub CommandButton1_Click()
Dim i As Long
Dim j As Long
Dim k As Long
Dim cla1 As Workbook
Dim cla2 As Workbook
Dim Feuil1 As Worksheet
Dim Feuil2 As Worksheet
Dim Feuil3 As Worksheet
Set cla1 = Workbooks("encour_x007E_1.xls")
Set cla2 = Workbooks("1500_mode_op_meca.xls")
Set Feuil1 = cla1.Worksheets("Feuil1")
Set Feuil2 = cla2.Worksheets("Feuil1")
Set Feuil3 = cla2.Worksheets("Feuil2")
k = Feuil3.Cells(65536, 5).End(xlUp).Row + 1
For i = 3 To Feuil2.Cells(65536, 2).End(xlUp).Row
  For j = 2 To Feuil1.Cells(65536, 5).End(xlUp).Row
     If Feuil1.Cells(i, 2).Value = Feuil2.Cells(j, 5).Value _
        And Feuil2.Cells(j, 5).Value <> "" Then
        Feuil1.Cells(i, 2).Interior.ColorIndex = 4
        Feuil2.Cells(j, 1).EntireRow.Copy _
            Destination:=Feuil3.Cells(k, 1)
        k = k + 1
     End If
  Next j
Next i
End Sub

rhalimi13 · Answer

Bonsoir,

j'ai essayé d'avancer sur ton code en l'adaptant à mes fichiers et feuilles, mais je bloque encore, il bug au niveau du nom des fichiers, alors j'ai essayé de mettre le chemein du fichier, mais non plus ca bloque, 
merci de voir si tu as du temps;

bonne soirée



Private Sub CommandButton1_Click()

Dim i As Long
Dim j As Long
Dim k As Long

Dim cla1 As Workbook
Dim cla2 As Workbook

Dim Feuil1 As Worksheet
Dim Feuil2 As Worksheet
Dim Feuil3 As Worksheet

Set cla1 = Workbooks("C:\Documents and Settings\fr000172\Desktop\J-8\encour_x007E_1.xls")
Set cla2 = Workbooks("C:\Documents and Settings\fr000172\Desktop\J-8\1500_mode_op_meca.xls")

Set Feuil1 = cla1.Worksheets("Feuil1")
Set Feuil2 = cla2.Worksheets("Feuil1")
Set Feuil3 = cla2.Worksheets("Feuil2")

k = Feuil3.Cells(65536, 5).End(xlUp).Row + 1

For i = 3 To Feuil2.Cells(65536, 5).End(xlUp).Row
  For j = 2 To Feuil1.Cells(65536, 18).End(xlUp).Row
  
     If Feuil1.Cells(i, 5).Value = Feuil2.Cells(j, 18).Value _
        And Feuil2.Cells(j, 18).Value <> "" Then
        
        Feuil1.Cells(i, 5).Interior.ColorIndex = 4
        Feuil2.Cells(j, 1).EntireRow.Copy _
            Destination:=Feuil3.Cells(k, 1)
        k = k + 1
     End If
  Next j
Next i

End Sub

gbinforme · Answer

bonjour

en l'adaptant à mes fichiers et feuilles,

C'est vraiment étonnant que le nom des feuilles n'ai pas changé ?

Un "Workbooks" est un classeur sur lequel tu travailles (work) et donc qui est ouvert et donc excel n'a vraiment rien à faire du chemin sauf si tu veux l'ouvrir ou le sauvegarder.

Donc la macro va très bien fonctionner si elle est lancée par un de tes classeurs et qu'ils sont tous les deux ouverts, avec seulement le nom du classeur pour savoir où travailler.

Si tu veux aller chercher des données dans un classeur sans l'ouvrir, la technique est plus complexe et surtout pas du tout adaptée à ce que tu veux faire : une macro qui compare les données de deux classeurs va prendre du temps pour le faire en mémoire mais si tu veux le faire directement sur le disque, tu vas pouvoir aller faire un bon repas avec le temps qu'il te faudra !

rhalimi13 · Answer

Bonjour, j'ai enfin réussi à faire tourner ton code; merci de ton aide; j'ai dû changer qques trucs pour l'adapter à mes fichiers excels origine: Dim i As Long Dim j As Long Dim k As Long Dim cla1 As Workbook Dim cla2 As Workbook Dim Feuil1 As Worksheet Dim Feuil2 As Worksheet Dim Feuil3 As Worksheet Set cla1 = Workbooks("encour_x007E_1.xls") Set cla2 = Workbooks("1500_mode_op_meca.xls") Set Feuil1 = cla1.Worksheets("Feuil1") Set Feuil2 = cla2.Worksheets("Feuil1") Set Feuil3 = cla2.Worksheets("Feuil2") k = Feuil3.Cells(65536, 5).End(xlUp).Row + 1 For i = 3 To Feuil2.Cells(65536, 2).End(xlUp).Row For j = 2 To Feuil1.Cells(65536, 5).End(xlUp).Row If Feuil1.Cells(i, 2).Value = Feuil2.Cells(j, 5).Value _ And Feuil2.Cells(j, 5).Value <> "" Then Feuil1.Cells(i, 2).Interior.ColorIndex = 4 Feuil2.Cells(j, 1).EntireRow.Copy _ Destination:=Feuil3.Cells(k, 1) k = k + 1 End If Next j Next i End Sub aprés retouche: Private Sub CommandButton1_Click() Dim i As Long Dim j As Long Dim k As Long Dim Feuil1 As Worksheet Dim Feuil2 As Worksheet Dim Feuil3 As Worksheet Set RencoursXls = Workbooks("Rencours.xls") Set Rmode_opXls = Workbooks("Rmode_op.xls") Set encoursF1 = RencoursXls.Worksheets("Feuil1") Set mode_opF1 = Rmode_opXls.Worksheets("Feuil1") Set mode_opF2 = Rmode_opXls.Worksheets("Feuil2") k = 1 For j = 1 To encoursF1.Range("A1").End(xlDown).Row For i = 3 To mode_opF1.Range("E4").End(xlDown).Row If encoursF1.Cells(j, 4).Value = mode_opF1.Cells(i, 5).Value _ And mode_opF1.Cells(i, 4).Value <> "" Then mode_opF1.Cells(i, 5).Interior.ColorIndex = 5 encoursF1.Cells(j, 4).Interior.ColorIndex = 4 mode_opF1.Cells(i, 1).EntireRow.Copy Destination:=mode_opF2.Cells(k, 1) k = k + 1 Exit For End If Next i Next j End Sub Je te remercie beaucoup de ton aide !! Heuresement qu'il y'a des gens comme toi; je te dis à bientôt

VBA, compter le nombre de ligne non masquée

27 réponses

Discussions similaires