Macro de controle de volumes
Bonjour,
Dans mon activité professionnelle, j'ai un tableau ou plusieurs personnes interviennent pour y renseigner des volumes théoriques dans un premier tant, puis réels dans un 2nd temps.
Ces volumes réels sont renseignés dans d'autres colonnes.
Jusqu'à présent j'utilisais un moyen de contrôle avec des mises en forme conditionnelles, mais cela ne fait qu'alourdir ou ralentir le fichier.
Aussi, j'ai pensé à une macro pour pouvoir contrôler la saisie, mais je bloque un peu.
Je voudrais que certaines cellules se "colorient" lorsque que mon test est vrai.
J'ai avancé un peu dans le code, mais j'ai des erreurs que je ne parviens pas à trouver.
N'étant pas un cador en vba, je vous montre ce que j'ai fait, vous demande si vous pourriez m'aiguiller pour que mon code fonctionne.
Dans l'attente de vos réponse, dans l'espoir que vous m'aiderez dans ma tâche,
Bien cordialement,
Je vous mets le code en spoil pour ne pas trop alourdir la chose.
Enfin, je ne peux pas joindre le fichier.
Sub Controle_volumes_reels()
Dim i, j, k, l, m, PremiereLigne As Long
Dim MaPlagereel, MaPlagetheo As Range
'on détecte le numéro de 1ère ligne filtrée
PremiereLigne = Range("_FilterDataBase").Offset(1, 0).Resize(Range("_FilterDataBase").Rows.Count - 1).SpecialCells(xlCellTypeVisible).Row
'on détecte le numéro de la dernière ligne filtrée
Range("A" & PremiereLigne).Select
i = Range("A65000").End(xlUp).Row
Cells(i, 1).EntireRow.Hidden = False
'On fait la boucle while
'Tanque que la 1ere ligne est inférieur à la dernière ligne
While PremiereLigne < i
'tant qu'on a pas atteint la dernière colonne du tableau
While j < 96
Range("L" & PremiereLigne).Select
'On set les numéros de colonne et de plage
j = 21
k = 25
l = 15
m = 19
Set MaPlagetheo = Range(Cells(PremiereLigne, l), Cells(PremiereLigne, m))
Set MaPlagereel = Range(Cells(PremiereLigne, j), Cells(PremiereLigne, k))
'On fait la mise en forme conditionnel (ou est-ce qu'on peut pas simplement colorier la celulle du magasin d'une couleur visible ?)
'NBVAL(MaPlagereel) < NBVAL(MaPlagetheo) Then
If "=COUNTA(Maplagereel)<COUNTA(Maplagetheo)" Then
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 10092543
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Else
'On incrémente nos variables
PremiereLigne = PremiereLigne + 1
j = j + 14
k = k + 14
l = l + 14
m = m + 14
End If
Wend
Wend
End Sub
J'édite pour joindre un extrait du fichier car le complet est lourd.
Bonjour,
sans savoir ou sont les erreurs et sans voir la structure du classeur, difficile d'apporter une aide.
Un classeur exemple avec la bonne structure et des données non confidentielles et quelques précisions pourraient bien nous aider à vous aider.
Si je devais intervenir je remplacerais les boucle while ...wend par des for... next (parce que je préfère...)
A+
Edit: ah bah... j'ai rien dit voila le classeur!
Désolé,
ma version XL doit être trop ancienne ( ou c'est mes neurones ...?)
mais je ne trouve pas à quoi correspond "_FilterDataBase" dans Range("_FilterDataBase").
Pas trouvé de plage nommée....de tableau ...
Désolé,
ma version XL doit être trop ancienne ( ou c'est mes neurones ...?)
mais je ne trouve pas à quoi correspond "_FilterDataBase" dans Range("_FilterDataBase").
Pas trouvé de plage nommée....de tableau ...
Bonjour,
Alors cette ligne je l'ai trouvée sur le net et elle me permet de détecter le 1er numéro de ligne filtrée.
Au boulot on est sur office 2010, et cette ligne fonctionne, elle me renvoie la bonne valeur.
Bonjour,
Je me réponds à moi même pour la solution que j'ai trouvé tout seul et pour en faire profiter quelqu'un..(on sait jamais, ça peut aider quelqu'un un jour)
Je le mets dans le spoiler
Sub Controle_volumes_reels()
Dim i, j, l, m, n, PremiereLigne As Long
'on détecte le numéro de 1ère ligne filtrée
PremiereLigne = Range("_FilterDataBase").Offset(1, 0).Resize(Range("_FilterDataBase").Rows.Count - 1).SpecialCells(xlCellTypeVisible).Row
'on détecte le numéro de la dernière ligne filtrée
Range("A" & PremiereLigne).Select
i = Range("A65000").End(xlUp).Row
Cells(i, 1).EntireRow.Hidden = False
DerniereColonne = ActiveSheet.UsedRange.Columns.Count
Application.ScreenUpdating = False
'On défini les valeurs de départ
j = 21
k = 25
l = 15
m = j + 4
n = 12
'On fait la boucle while
'Tanque que la 1ere ligne est inférieur à la dernière ligne
While PremiereLigne <= i
'tant qu'on a pas atteint la dernière colonne du tableau
While j <= DerniereColonne
If Cells(PremiereLigne, n) = "" Then
j = n + 9
l = n + 3
n = n + 14
m = j + 4
Else
'On set les numéros de colonne et de plage
'On teste si nbval reel<Nbval theo = vrai
If Application.WorksheetFunction.CountA(Cells(PremiereLigne, j)) <> Application.WorksheetFunction.CountA(Cells(PremiereLigne, l)) Then
'On colorie la cellule magasin si le nbval reel<Nbval theo
Cells(PremiereLigne, j).Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
End If
'On incrémente nos variables
'Si on est au bout de la colonne réels, alors on passe au magasin suivant
If j = m Then
j = j + 10
l = l + 10
n = n + 14
m = j + 4
Else
End If
'On change de colonne
j = j + 1
l = l + 1
End If
Wend
'On incrémente
PremiereLigne = PremiereLigne + 1
j = 21
l = 15
n = 12
m = j + 4
Wend
Application.ScreenUpdating = True
End Sub
C'est très certainement perfectible, mais moi ça me va