Msgbox comptage cellules vides jusqu'à aujourd'hui
Bonjour à tous.
Je viens une fois de plus solliciter votre aide pour une petite msgbox au démarrage de mon tableau d'enregistrement.
Je voudrais qu'elle compte les cellules vides en colonne L jusqu'à la date du jour en colonne A et me donne le total dans une petite phrase du type "il reste x échantillons à contrôler".
Merci beaucoup par avance.
Chris
Bonjour,
à tester,
Sub test()
rw = Cells(Rows.Count, "A").End(xlUp).Row
x = Application.CountIf(Range("L2:L" & rw), "")
MsgBox "il reste " & x & " échantillons à contrôler"
End SubBonjour Serialpyro,
Autre proposition à coller dans le code "Workbook_Open" du classeur (si ce n'est pas déjà le cas, le classeur doit être de type .xlsm)
Private Sub Workbook_Open()
Const cFirstRow = 13 'Indiquer la première ligne du tableau
Const cTestCol = 12 'le numéro de colonne à tester "L"
Dim oRange As Range, oCurrentDateRange As Range, oCell As Range
Dim lNb As Long
Dim dDate As Date
Dim lLastrow As Long
'Modifier "NomFeuille" par le nom de ta feuille
With ThisWorkbook.Worksheets("NomFeuille")
'Recherche de la dernière ligne du jour
dDate = Date
Set oRange = .Columns(1)
'Recherche de la ligne du tableau contenant la date du jour
Set oCurrentDateRange = oRange.Find(dDate, , xlValues, xlPart, xlByRows, xlNext, False, False, False)
If Not oCurrentDateRange Is Nothing Then
lLastrow = oCurrentDateRange.Row
'Constitution de la plage dont les valeurs sont à contrôler
Set oRange = .Range(.Cells(cFirstRow, cTestCol), .Cells(lLastrow, cTestCol))
'Boucle sur les cellule de la plage à contrôler
For Each oCell In oRange.Cells
If IsEmpty(oCell.Value) Then
'Si pas de valeur, +1 sur le compteur
lNb = lNb + 1
End If
Next
MsgBox "Il reste " & lNb & " échantillon" & IIf(lNb > 1, "s", "") & " à contrôler"
Else
'En cas d'echec de la recherche
MsgBox "La date du jour : " & Format(dDate, "dd/mm/yyyy") & " n'a pas été trouvée dans le tableau"
End If
End With
End SubBonjour,
vue l'image de ton tableau alors la plage commence à la ligne 13 sauf erreur.
Ci-après tous les calculs pour les infos que tu souhaites afficher dans une msg box dans workbook open :
Dim X As Long 'DERNIERE LIGNE SAISIE
Dim Y As Long 'PREMIERE LIGNE DE SAISIE
Dim Z As Long 'NOMBRE CELLULES RESEIGNEES DANS "L"
Dim S As Long 'NOMBRE DE VALEUR A RENSEIGNER DANS "L"
Dim R As Long 'SUR UN TOTAL DE SAISE DE
X = Range("A65536").End(xlUp).Row
Y = 13
S = WorksheetFunction.CountBlank(Range(Cells(Y, 12), Cells(X, 12))) ' NOMBRE CELLULES NON RENSEIGNEES
Z = X - Y + 1 - S
R = X - Y + 1Merci beaucoup à vous.
J'essaie de comprendre un peu tout ça et vous tiens vite au courant car je n'ai pas accès au fichier hors du boulot.
Ça commence bien ligne 13 Oui.
Bonjour Serialpyro,
Autre proposition à coller dans le code "Workbook_Open" du classeur (si ce n'est pas déjà le cas, le classeur doit être de type .xlsm)
Private Sub Workbook_Open() Const cFirstRow = 13 'Indiquer la première ligne du tableau Const cTestCol = 12 'le numéro de colonne à tester "L" Dim oRange As Range, oCurrentDateRange As Range, oCell As Range Dim lNb As Long Dim dDate As Date Dim lLastrow As Long 'Modifier "NomFeuille" par le nom de ta feuille With ThisWorkbook.Worksheets("NomFeuille") 'Recherche de la dernière ligne du jour dDate = Date Set oRange = .Columns(1) 'Recherche de la ligne du tableau contenant la date du jour Set oCurrentDateRange = oRange.Find(dDate, , xlValues, xlPart, xlByRows, xlNext, False, False, False) If Not oCurrentDateRange Is Nothing Then lLastrow = oCurrentDateRange.Row 'Constitution de la plage dont les valeurs sont à contrôler Set oRange = .Range(.Cells(cFirstRow, cTestCol), .Cells(lLastrow, cTestCol)) 'Boucle sur les cellule de la plage à contrôler For Each oCell In oRange.Cells If IsEmpty(oCell.Value) Then 'Si pas de valeur, +1 sur le compteur lNb = lNb + 1 End If Next MsgBox "Il reste " & lNb & " échantillon" & IIf(lNb > 1, "s", "") & " à contrôler" Else 'En cas d'echec de la recherche MsgBox "La date du jour : " & Format(dDate, "dd/mm/yyyy") & " n'a pas été trouvée dans le tableau" End If End With End Sub
Merci beaucoup, c'est parfait.
Cependant, j'ai une erreur en démarrant car le matin je n'ai encore aucun controle à date du jour donc il faudrait une limite à date de la veille. Sur quelle ligne je marque "currentdate -1" ?
Bonjour Serialpyro,
Autre proposition à coller dans le code "Workbook_Open" du classeur (si ce n'est pas déjà le cas, le classeur doit être de type .xlsm)
Private Sub Workbook_Open() Const cFirstRow = 13 'Indiquer la première ligne du tableau Const cTestCol = 12 'le numéro de colonne à tester "L" Dim oRange As Range, oCurrentDateRange As Range, oCell As Range Dim lNb As Long Dim dDate As Date Dim lLastrow As Long 'Modifier "NomFeuille" par le nom de ta feuille With ThisWorkbook.Worksheets("NomFeuille") 'Recherche de la dernière ligne du jour dDate = Date Set oRange = .Columns(1) 'Recherche de la ligne du tableau contenant la date du jour Set oCurrentDateRange = oRange.Find(dDate, , xlValues, xlPart, xlByRows, xlNext, False, False, False) If Not oCurrentDateRange Is Nothing Then lLastrow = oCurrentDateRange.Row 'Constitution de la plage dont les valeurs sont à contrôler Set oRange = .Range(.Cells(cFirstRow, cTestCol), .Cells(lLastrow, cTestCol)) 'Boucle sur les cellule de la plage à contrôler For Each oCell In oRange.Cells If IsEmpty(oCell.Value) Then 'Si pas de valeur, +1 sur le compteur lNb = lNb + 1 End If Next MsgBox "Il reste " & lNb & " échantillon" & IIf(lNb > 1, "s", "") & " à contrôler" Else 'En cas d'echec de la recherche MsgBox "La date du jour : " & Format(dDate, "dd/mm/yyyy") & " n'a pas été trouvée dans le tableau" End If End With End SubMerci beaucoup, c'est parfait.
Cependant, j'ai une erreur en démarrant car le matin je n'ai encore aucun controle à date du jour donc il faudrait une limite à date de la veille. Sur quelle ligne je marque "currentdate -1" ?
J'ai trouvé tout seul. Encore merci.
Je coche résolu.
J'ai trouvé tout seul. Encore merci.
Je coche résolu.
Re-bonjour.
Petite question complémentaire, est-ce possible de rajouter dans cette même box à l'ouverture, le calcul d'une deuxième colonne, selon les mêmes paramètres ?
Re-bonjour.
Petite question complémentaire, est-ce possible de rajouter dans cette même box à l'ouverture, le calcul d'une deuxième colonne, selon les mêmes paramètres ?
Tu ajoutes toutes les infos dans ta msgbox ,faut juste les séparer par &
Bonjour SerialPyro,
Oui, tu peux ajouter dans la boucle un autre calcul, il te suffit de déclarer une seconde série de variables :
Const cTestCol2 = 13 'Par exemple si la nouvelle colonne à tester "M"
Dim lNb2 As Longd'inclure une nouvelle boucle à la suite de la première:
Set oRange = .Range(.Cells(cFirstRow, cTestCol), .Cells(lLastrow, cTestCol))
'Boucle sur les cellule de la plage à contrôler
For Each oCell In oRange.Cells
If IsEmpty(oCell.Value) Then
'Si pas de valeur, +1 sur le compteur
lNb = lNb + 1
End If
Next
Set oRange = .Range(.Cells(cFirstRow, cTestCol2), .Cells(lLastrow, cTestCol2))
'Boucle sur les cellule de la plage à contrôler
For Each oCell In oRange.Cells
If IsEmpty(oCell.Value) Then
'Si pas de valeur, +1 sur le compteur
lNb2 = lNb2 + 1
End If
Nextet de modifier le texte affiché par msgbox :
MsgBox "Il reste " & lNb & " échantillon" & IIf(lNb > 1, "s", "") & " à contrôler" & vbcrlf & "Nouveau message..." & lNb2(Code non testé mais qui devrait fonctionner...)
C'est la meilleure façon de t'approprier ce qui et proposé...
Tu peux te manifester à nouveau en cas de nouvelles difficultés, sinon :
