Mise à jour des imputations (Résolue par Job)

an@s

XLDnaute Occasionnel
Bonjour à tous,

dans le fichier ci-joint j'ai un code qui m'a fourni job qui permet de faire l'importation des données d'un autre fichier sauf les cellules qui sont en gras.
après importation le code rajoute des nouvelles lignes dont L est vide, donc les cellules de la colonne L je dois les remplir manuellement.
ce que je souhaite faire c'est créer un autre code qui permet de faire cela :

si j'ai plusieurs données dans la colonne A qui sont les mêmes et une données ou plusieurs de la colonne A ont déjà la colonne L remplie, donc il faut copier cette donnée dans les autres cellules vides de la colonne L

exemple :
A9= A10, A11, A12, A13 puis L9 est déjà remplie dont il faut copier L9 dans L10, L11, L12, L13 et la couleur de remplissage de L10, L11, L12, L13 soit jaune

Merci beaucoup pour votre assistance

Cordialement
An@s
 

Pièces jointes

  • MATERIEL.xlsm
    50.2 KB · Affichages: 24

an@s

XLDnaute Occasionnel
Merci beaucoup Job pour la modification,
vous êtes vraiment parfait dans vos réponses, vous ne laissez jamais mêmes les petits détails...
une petite question si vous permettez; dans le cas ou la colonne A était E qu'est ce qu'il faut changer ??

je vous remercie encore une autre fois

Amicalement
An@s
 

job75

XLDnaute Barbatruc
Bonjour an@s, le forum,

2 compléments qui peuvent être intéressants avec ce fichier (5) :

- affichage des données si la feuille est filtrée

- RAZ préalable des cellules colorées.
Code:
Function Couleur(c As Range)
Couleur = IIf(c.Interior.ColorIndex = xlNone, "", 1)
End Function

Sub MAJ_Imputation()
Dim ncol%
Application.ScreenUpdating = False
On Error Resume Next 's'il n'y a pas de SpecialCells
With Feuil01.[A7].CurrentRegion
  .Parent.ShowAllData 'si la feuille est filtrée
  With .Offset(1).Resize(.Rows.Count - 1)
    ncol = .Columns.Count
    .Columns(ncol + 1) = "=Couleur(RC[-1])" '1ère colonne auxiliaire
    Intersect(.Columns(ncol), Columns(ncol + 1).SpecialCells(xlCellTypeFormulas, 1).EntireRow) = "" 'RAZ des cellules colorées
    .Columns(ncol).Interior.ColorIndex = xlNone 'RAZ couleur
    .Cells(1, ncol + 1) = 1
    .Columns(ncol + 1).DataSeries '1ère colonne auxiliaire, ordre initial numéroté
    .Columns(ncol + 2) = 0
    Intersect(.Columns(ncol).SpecialCells(xlCellTypeBlanks).EntireRow, .Columns(ncol + 2)) = 1 '2ème colonne auxiliaire
    .Resize(, ncol + 2).Sort .Columns(ncol + 2), xlAscending, Header:=xlNo 'tri sur la 2ème colonne auxiliaire
    With .Columns(ncol).SpecialCells(xlCellTypeBlanks) 'cellules vides regroupées en bas de la colonne par le tri
      .FormulaR1C1 = "=IF(ROW()=MATCH(RC1,C1,0),"""",INDEX(C,MATCH(RC1,C1,0)))" 'copie la 1ère occurence
      .Value = .Value 'supprime les formules
      .SpecialCells(xlCellTypeConstants).Interior.ColorIndex = 6 'jaune
    End With
    .Resize(, ncol + 1).Sort .Columns(ncol + 1), xlAscending, Header:=xlNo 'remise en ordre initial
    .Columns(ncol + 1).Resize(, 2) = "" 'RAZ des 2 colonnes auxiliaires
  End With
End With
End Sub
Testé sur 30 000 lignes, on passe de 1 à 2 secondes en durée d'exécution, c'est donc acceptable.

Bonne journée.
 

Pièces jointes

  • MATERIEL(5).xlsm
    58.1 KB · Affichages: 25

Discussions similaires

Statistiques des forums

Discussions
311 740
Messages
2 082 047
Membres
101 880
dernier inscrit
Anton_2024