VBA répétition de valeur dans des cellules . [Résolu/Fermé]

Signaler
Messages postés
471
Date d'inscription
mardi 1 juin 2004
Statut
Membre
Dernière intervention
21 février 2018
-
Messages postés
11213
Date d'inscription
jeudi 18 janvier 2007
Statut
Modérateur
Dernière intervention
10 octobre 2019
-
Bonjour, Bonjour, je suis las de cherché, alors je viens demander directement.

je cherche reproduire sur une ligne la valeur autant de fois que nécessaire :

a savoir :
Sheets("Post_ext").Cells(ligne_engin + 1, sem_debut ).Interior.ColorIndex = 3

avec ca j'ai la cellule de début, et j'ai la fin :

Sheets("Post_ext").Cells(ligne_engin + 1, sem_fin ).Interior.ColorIndex = 3

je veux pouvoir à l'aide d'un range, colorer l'intégralité des cellules entre les deux (comprenant les cellules du début et de fin bien sur)

j'y mettrais également des valeurs (la même pour toutes)



merci de votre aide, la je trouve plus ...


3 réponses

Messages postés
15352
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
28 septembre 2020
1 362
Bonjour,

Sheets("feuil1").Range(Cells(ligne_engin + 1, sem_debut), Cells(ligne_engin + 1, sem_fin)).Interior.ColorIndex = 3


Bonne suite
4
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 60769 internautes nous ont dit merci ce mois-ci

Messages postés
471
Date d'inscription
mardi 1 juin 2004
Statut
Membre
Dernière intervention
21 février 2018
38
Bon sang, ok !!!
je me serais pas douté que je devais re-déclaré cells encore une fois !! :)


un grand merci, je vais beaucoup avancé now.

tu pige bien en vba ? j'ai un autre soucis qui apparaît ! :)

Messages postés
15352
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
28 septembre 2020
1 362
Re,
Product of France

Pour le code, c'est de du VBA excel pour EXCEL
Messages postés
471
Date d'inscription
mardi 1 juin 2004
Statut
Membre
Dernière intervention
21 février 2018
38
ok, je me disais aussi ^^.

je suis de formation php , vba connais pas. ;)

tu en est ou du code ?
Messages postés
15352
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
28 septembre 2020
1 362
Re,
Moi non plus.
J'en suis a ce que j'ai dit ce matin.
Messages postés
471
Date d'inscription
mardi 1 juin 2004
Statut
Membre
Dernière intervention
21 février 2018
38
ok, par contre j'ai vu que tu avais mis dans la ligne qui est créer : l'opération

Hors c'est : valeur = ("RA à " & etb)
qu'il me faudrait mettre... enfin je verrais ca plus tard.
Messages postés
471
Date d'inscription
mardi 1 juin 2004
Statut
Membre
Dernière intervention
21 février 2018
38
et pour répondre à ta question :

.Select
'On refais la selection de la feuille "SAQ Extérieur"
.Range("A2:u" & DLnVCA).Select '?????????????? pourquoi

Je sais pas ^^
Messages postés
15352
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
28 septembre 2020
1 362
Re,
ok, par contre j'ai vu que tu avais mis dans la ligne qui est créer : l'opération

Hors c'est : valeur = ("RA à " & etb)
qu'il me faudrait mettre... enfin je verrais ca plus tard.


Samedi, j'ai pris ce code

Sub Macrosaq()
Application.ScreenUpdating = False
' Macro4 Macro
' Macro enregistrée le 13/04/2012 par 8606174m

'Information :
' While : Le While est une boucle qui fait le tour des informations contenu dans les cellules
' ~ : Ce sigle au début d'un commentaire indique la fermeture d'une requête (précédemment commenté)


'Paramètrage des données de base :
i = 2

'On Selectionne la feuille "SAQ extérieur" (like : ctrl+A)
Sheets("SAQ Extérieur").Select

'On va référencer les données en fonction du n° de l'engin : no_engin & de sa série
no_engin = format_engin(Sheets("SAQ Extérieur").Cells(i, 1).Value, Sheets("SAQ Extérieur").Cells(i, 2).Value)


'On relève l'opération de maintenance de l'engin selectionné précedemment.
Dim operation As String
operation = Sheets("SAQ Extérieur").Cells(i, 5).Value

'On récupère la valeur de la durée d'immobilisation
Dim duree7j As String
duree7j = Sheets("SAQ Extérieur").Cells(i, 13).Value

'On récupère les infos de la semaine et de l'année d'entrée
annee_entree = Sheets("SAQ Extérieur").Cells(i, 4).Value 'Retourne la donnée brut (ex: jj/mm/aaaa hh:mm:ss)'.
Dim A1 As String
A1 = Mid(annee_entree, 7, 4) 'Extrait de "annee_entree" uniquement l'année en question'.
semaine_entree = Sheets("SAQ Extérieur").Cells(i, 14).Value 'Retourne le numéro de la semaine d'entrée'.
annee_rat = Sheets("SAQ Extérieur").Cells(i, 7).Value 'Retourne la donnée brut (ex: jj/mm/aaaa hh:mm:ss)'.
Dim a2 As String
a2 = Mid(annee_rat, 7, 4) 'Extrait de "annee_rat" uniquement l'année en question'.
semaine_rat = Sheets("SAQ Extérieur").Cells(i, 15).Value 'Retourne le numéro de la semaine de remise à temps'.

'On passe à la ligne d'après
While Sheets("SAQ Extérieur").Cells(i, 1) <> ""

i = i + 1
Wend

'On refais la selection de la feuille "SAQ Extérieur"
Sheets("SAQ Extérieur").Select
Sheets("SAQ Extérieur").Range("A2:u" & i).Select





' -------------------------------------------------------------------------------------'
' 2ème Etapes : '
' Vérification que c'est un engin listé dans la feuille "Post_ext" '
' On collecte ainsi les données "année & semaines " de début et de fin d'intervention. '
' -------------------------------------------------------------------------------------'
' PS: On as une particularité pour les engins étant immobilisé depuis 2011. '
'--------------------------------------------------------------------------------------'

'Remplissage tableau prog
ligne_engin = 0 'On saisie une valeur NULL'
ligne = 5 'On commence à vérifier à partir de la ligne 6 (début des données brut)'
col = 5


'On selectionne la feuille "Post_ext"
Sheets("Post_ext").Select

'On fait la boucle pour récupérer les données de la feuille "Post_ext"
While Sheets("Post_ext").Cells(ligne, 2) <> ""

'Si on trouve une ligne dont la valeur est égale au N° de l'engin recherché :
If Sheets("Post_ext").Cells(ligne, 4).Value = no_engin Then

'On défini par positif la présence de l'engin dans la flotte prog.
'La ligne de l'engin dans la feuille est donc selectionné et identifié en "ligne_engin".
ligne_engin = ligne


'---------------------------------------------------'
' '
'---(info)--' Particularité pour l'année 2011 '
' '
'---------------------------------------------------'
'Si on trouve l'année identique à l'année présenté en annee_entree :
If A1 = 2011 Then

Dim A2012 As String

A2012 = Replace(annee_entree, annee_entree, "01/01/2012")
'On Extrait de "annee_entree" uniquement l'année en question'
A1 = Mid(A2012, 7, 4)
semaine_entree = 1


'------------------------------------'
'MsgBox ("Date 2011 Modifié en 2012") '
' Flag de test de modification '
' (Ne pas en tenir compte) '
'------------------------------------'
End If
'---------------------------------------------------'
' '
'---(info)--' Fin de Particularité pour l'année 2011 '
' '
'---------------------------------------------------'


'On saisie la valeur de A6 mais dans un String afin d'avoir une valeur Brut.
Dim A6 As String
A6 = Sheets("Post_ext").Cells(2, col).Value

'Si on trouve l'année identique à l'année présenté en annee_entree :
If A1 = A6 Then

'Si la cellule est identique à semaine_entree :
If (Sheets("Post_ext").Cells(4, col).Value = semaine_entree) Then


'------------------------------------------'
' Maintenant qu'on as la date de début '
' On prend la date de fin '
' d'opération '
'------------------------------------------'

'On récupère les infos de la semaine et de l'année Remise à Temps
col_fin = 5 'On commence à vérifier la fin à partir de la première colonne d'intervention.
sem_fin = 5 'On commence à vérifier la fin à partir de la première colonne d'intervention.

'On fait une boucle pour trouver la cellule de fin d'intervention
While Sheets("Post_ext").Cells(ligne_engin, col_fin) <> ""

'on cherche la cellule correspondant à l'année de "remise à temps".
If (Sheets("Post_ext").Cells(2, col_fin) = a2) Then

'une fois trouvé, on cherche la cellule correspondante à la semaine de "remise à temps".
If (Sheets("Post_ext").Cells(4, sem_fin) = semaine_rat) Then
'Une fois trouvé, on l'identifie pour plus tard

range_fin = getCell(ligne_engin, sem_fin)

End If '~Si on trouve pas la semaine de rat, on rajoute +1 et on passe à la colonne suivante :
sem_fin = sem_fin + 1

End If '~Si on trouve pas l'année de rat, on rajoute +1 et on passe à la colonne suivante :
col_fin = col_fin + 1
Wend


' ---------------------------------------------------------------------------------------------'
' 3ème Etapes : '
' Désormais on va inscrire la ligne de l'engin en fonction des données collectés '
' Et si jamais la ligne contient déja une valeur, on écrira dans une nouvelle ligne au dessous '
'----------------------------------------------------------------------------------------------'


'On vérifie si l'opération de saisi et la même que dans sa ligne de destination'
If Sheets("Post_ext").Cells(ligne_engin, col).Value = operation Then

'---------------------------------------------------------------------------------'
'Si c'est le cas, alors on ne va pas mettre à jour les données pour cette ligne. '
'---------------------------------------------------------------------------------'
Else




'sinon on vérifie la ligne suivante pour savoir si elle appartient elle aussi au même engin'
If Sheets("Post_ext").Cells(ligne_engin + 1, 4).Value = no_engin Then


'Si elle appartient aussi au même engin, on recommence la même opération :
'On vérifie si l'opération a écrire se situe dans la cellule "operation"
If InStr(1, Sheets("Post_ext").Cells(ligne_engin + 1, col).Value, Trim(operation), 1) > 0 Then
ligne_engin = ligne_engin + 1
'---------------------------------------------------------------------------------'
'Si c'est le cas, alors on ne va pas mettre à jour les données pour cette ligne. '
'---------------------------------------------------------------------------------'


Else ' Si ce n'est pas le cas, alors on va vérifier si la plage d'intervention de la ligne n'est pas vide :
range_debut = getCell(ligne_engin + 1, col)
If IsEmpty(range_debut) = True Then
'---------------------------------------------------------------------------------'
'Si c'est le cas, alors on ne va pas mettre à jour les données pour cette ligne. '
'---------------------------------------------------------------------------------'


Else 'Elle contient une information, alors :
'---------------------------------------------------------------------------------'
' on as trouvé l'emplacement pour l'intervention alors '
' on écrit les données dans la ligne en question. '
'---------------------------------------------------------------------------------'
'-----------------'
' création ligne '
'-----------------'
ligne_d_ajout = "" & (ligne_engin + 1) & ":" & (ligne_engin + 1) & ""
Sheets("Post_ext").Select
Rows(ligne_d_ajout).Select
Selection.Insert Shift:=xlDown
range_debut = getCell(ligne_engin + 1, col)
Sheets("Post_ext").Cells(ligne_engin + 1, 1).Value = Sheets("Post_ext").Cells(ligne_engin, 1).Value
Sheets("Post_ext").Cells(ligne_engin + 1, 2).Value = Sheets("Post_ext").Cells(ligne_engin, 2).Value
Sheets("Post_ext").Cells(ligne_engin + 1, 3).Value = Sheets("Post_ext").Cells(ligne_engin, 3).Value
Sheets("Post_ext").Cells(ligne_engin + 1, 4).Value = Sheets("Post_ext").Cells(ligne_engin, 4).Value
Sheets("Post_ext").Cells(ligne_engin + 1, col).Value = operation

ligne_engin = ligne_engin + 1


End If '~End de : écrit les données.
End If


Else 'Si ce n'est pas la ligne du même engin :

'---------------------------------------------------------------------------------'
' On n'as pas trouvé de place dans les précédentes lignes de l'engin '
' pour pouvoir écrire les données dans la ligne en question. '
' alors on va simplement insérer une nouvelle ligne '
' pour l'engin qui nous interesse.
'---------------------------------------------------------------------------------'

'-----------------'
' création ligne '
'-----------------'
ligne_d_ajout = "" & (ligne_engin + 1) & ":" & (ligne_engin + 1) & ""
Sheets("Post_ext").Select
Rows(ligne_d_ajout).Select
Selection.Insert Shift:=xlDown
range_debut = getCell(ligne_engin + 1, col)
'--------------------------'
' Inscriptions des données '
'--------------------------'
Sheets("Post_ext").Cells(ligne_engin + 1, 1).Value = Sheets("Post_ext").Cells(ligne_engin, 1).Value
Sheets("Post_ext").Cells(ligne_engin + 1, 2).Value = Sheets("Post_ext").Cells(ligne_engin, 2).Value
Sheets("Post_ext").Cells(ligne_engin + 1, 3).Value = Sheets("Post_ext").Cells(ligne_engin, 3).Value
Sheets("Post_ext").Cells(ligne_engin + 1, 4).Value = Sheets("Post_ext").Cells(ligne_engin, 4).Value
Sheets("Post_ext").Range(Cells(ligne_engin + 1, col), Cells(ligne_engin + 1, sem_fin - 1)).Value = operation


'Si la durée d'immobilisation de la cellule 13 : "Jour d'immob" est supérieur ou égal à 6Jours
If (duree7j > 6) Then


'On change la couleur de la ligne
Sheets("Post_ext").Range(Cells(ligne_engin + 1, col), Cells(ligne_engin + 1, sem_fin - 1)).Interior.ColorIndex = 3
Sheets("Post_ext").Range(Cells(ligne_engin + 1, col), Cells(ligne_engin + 1, sem_fin - 1)).Font.Bold = True
Sheets("Post_ext").Range(Cells(ligne_engin + 1, col), Cells(ligne_engin + 1, sem_fin - 1)).Font.ColorIndex = 52
End If

'Sheets("Post_ext").Cells(ligne_engin + 1, col).Font.Bold = True

End If '~Fin de la création de la ligne'




End If '~Fin de : Si même opération'

End If '~Fin de : identique à semaine_entree, Sinon on passe à la colonne suivante afin de trouvé la semaine correspondante'
col = col + 1

End If '~Fin de : Si même année, Sinon on passe à la colonne suivante afin de trouvé l'année correspondante'
col = col + 1


ligne = ligne + 1
i = i + 1
End If '~Si on n'as pas trouvé l'engin correspondant, on rajoute +1 et on consulte la ligne suivante:'


Wend





MsgBox ("Boucle Terminé avec succès")







End Sub

Donc je vais analyser le code du fichier Tableau5 - Copie.xls puisqu'il y des differences.

'On refais la selection de la feuille "SAQ Extérieur"
.Range("A2:u" & DLnVCA).Select '?????????????? pourquoi

Je sais pas ^^


Qui va savoir??
Messages postés
471
Date d'inscription
mardi 1 juin 2004
Statut
Membre
Dernière intervention
21 février 2018
38
MP !
Messages postés
11213
Date d'inscription
jeudi 18 janvier 2007
Statut
Modérateur
Dernière intervention
10 octobre 2019
1 846
Bonjour,
Le forum a pour but d'aider les gens qui le demandent mais aussi ceux qui consultent le site et les messages a posteriori et qui ont besoin d'aide.
Par conséquent, les solutions consistant à donner de l'aide aux utilisateurs via MP ne sont pas les bienvenues sur le forum.

Merci de mettre directement les solutions directement sur le forum afin d'aider un plus grand nombre de personnes :-)
Messages postés
15352
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
28 septembre 2020
1 362
Bonjour,

ViriisXP pouvez vous repondre a krazykat sur ce sujet?
Messages postés
471
Date d'inscription
mardi 1 juin 2004
Statut
Membre
Dernière intervention
21 février 2018
38
oui , pardon mais comme le doc. suivant contenais des données de société, je voulais éviter de le donner au plus grand monde.
Messages postés
11213
Date d'inscription
jeudi 18 janvier 2007
Statut
Modérateur
Dernière intervention
10 octobre 2019
1 846
Je n'avais pas tout compris ^^
Pas de souci pour donner les liens en privés, mais juste expliquer les résolutions, si ça peut aider des internautes ;-)