XL 2013 besoin d'aide pour modification code VBA

an@s

an@s

XLDnaute Occasionnel
Bonjour à tous,
dans mon l'exemple ci-joint j'ai une macro qui me permet d'importer le nom des employés du classeur Paie-Mens vers Refac,
dans le ficher Refac en cliquant sur "copier données" le code copie les noms de tout les employés du mois en cours y compris les nouveaux, et moi ce que je fais par la suite je donne à chaque employé une imputation (colonne AD) et à la fin de chaque mois je copie tout les noms des employés que j'ai dans la colonne F dans la colonne AE pour faire la comparaison par la suite.
le problème c'est que si j'ai des nouveaux employés et en faisant l'importation des données, , la colonne F ou j'ai les noms se décale mais la colonne AD ou j'ai les imputations ne bouge pas.

donc ce que je souhaite avoir en faisant l'importation:
-si un nom existe dans la colonne F et n'existe pas dans la colonne AE donc il s'agit d'un nouveau employé donc ajouter une ligne avec la cellule de la colonne AD vide
-si un nom existe dans la colonne AE et n'existe pas dans la colonne F donc un employé ne bosse plus dans cette société donc supprimer la ligne qui correspond a cette employé

Merci d'avance
 

Pièces jointes

  • REFAC.zip
    76.9 KB · Affichages: 75
Trier par date Trier par votes
an@s

an@s

XLDnaute Occasionnel
Bonjour Job, le forum,
je reviens vers vous à nouveau pour vous demander si c'est possible d'appliquer la macro que vous m'avez fourni hier sur mon exemple ci-joint en faisant une modification.

dans mon exemple ci-inclus j'ai déjà un code avec lequel je fais le calcule de mon bilan monétaire et ça marche parfaitement ( lié au bouton "recalculer la matrice").

en revanche dans mon fichier "Bilan monétaire" j'ai inséré un bouton qui s'appelle "importation des données" et j'aimerais le lier avec votre code d'hier pour importer les données du fichier "Matrice" avec 4 conditions :
  • importer toutes les données sauf les colonnes E, M, N, O, W, AJ, AS
  • conserver la même mise en forme après importation que j'ai dans le fichier "Bilan monétaire"
  • si j'ajoute des lignes dans le fichier "Matrice", après importation dans "Bilan monétaire" doivent être ajoutées aussi avec les mêmes formules des autres lignes du fichier destination "Bilan monétaire"
  • si je supprime des lignes dans le fichier "matrice", après importation dans "Bilan monétaire" doivent être supprimées aussi
Merci d'avance

Amicalement
Ana@s
 

Pièces jointes

  • Bilan.zip
    109.5 KB · Affichages: 62
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour an@s, le forum,

Ce problème est bien différent du précédent, le traitement est beaucoup plus lourd.

D'après ce que je comprends :
Code: 
Private Sub CommandButton1_Click()
Dim ncol%, nlig&, t, nlig1&, P As Range, d As Object, i&, P1 As Range, x$, j&
ncol = 45 'nombre de colonnes du tableau, adaptable
Application.ScreenUpdating = False
With Workbooks.Open(ThisWorkbook.Path & "\Matrice.xlsx").Sheets("MNT")
  nlig = .Range("C" & .Rows.Count).End(xlUp).Row
  If nlig > 1 Then nlig = nlig - 1
  .[E2].Resize(nlig) = "=RC[4]-RC[7]-SUM(RC[13]:RC[17])-SUM(RC[19]:RC[30])"
  .[M2].Resize(nlig) = "=RC[-4]-RC[-1]"
  .[N2].Resize(nlig) = "=RC[-2]+(RC[31]+RC[22]+RC[9])"
  .[O2].Resize(nlig) = "=IFERROR(RC[-3]/RC[-1],"""")"
  .[W2].Resize(nlig) = "=SUM(RC[-5]:RC[-1])"
  .[AJ2].Resize(nlig) = "=SUM(RC[-12]:RC[-1])"
  .[AS2].Resize(nlig) = "=SUM(RC[-8]:RC[-3])"
  t = .[A2].Resize(nlig, ncol).FormulaR1C1
  .Parent.Close False
End With
'---restitution des valeurs et formules du 1er tableau---
nlig1 = Range("C" & Rows.Count).End(xlUp).Row + 2
With [A3].Resize(nlig1, ncol)
  .Borders.LineStyle = xlNone 'supprime les bordures
  .Copy [A3].Offset(, ncol) 'sauvegarde TOUT le tableau vers la droite
  .Delete xlUp 'RAZ
End With
Set P = [A3].Resize(nlig, ncol)
P = t
'---liste des "Hiérarchie OTP" du 1er tableau (sans doublon)---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To nlig
  If t(i, 3) <> "" Then d(t(i, 3)) = i 'repère la ligne
Next i
'---copie les lignes du 2ème tableau vers le 1er---
Set P1 = [A3].Offset(, ncol).Resize(nlig1, ncol)
For i = 1 To nlig1
  x = P1(i, 3)
  If x <> "" And d.Exists(x) Then
    j = d(x)
    If Not P1(i, "E").HasFormula Then P(j, "E") = P1(i, "E") 'est-ce bien nécessaire ?
    If Not P1(i, "M").HasFormula Then P(j, "M") = P1(i, "M")
    If Not P1(i, "N").HasFormula Then P(j, "N") = P1(i, "N")
    If Not P1(i, "O").HasFormula Then P(j, "O") = P1(i, "O")
    If Not P1(i, "W").HasFormula Then P(j, "W") = P1(i, "W")
    If Not P1(i, "AJ").HasFormula Then P(j, "AJ") = P1(i, "AJ")
    If Not P1(i, "AS").HasFormula Then P(j, "AS") = P1(i, "AS")
    P1.Rows(i).Copy
    P(j, 1).PasteSpecial xlPasteFormats 'copie les couleurs
  End If
Next i
P1.EntireColumn.Delete 'RAZ
'---bordures---
P.Borders(xlEdgeLeft).Weight = xlThin
P.Borders(xlEdgeTop).Weight = xlThin
P.Borders(xlEdgeRight).Weight = xlThin
P.Borders(xlEdgeBottom).Weight = xlMedium 'pourquoi pas...
P.Borders(xlInsideVertical).Weight = xlThin
P.Borders(xlInsideHorizontal).Weight = xlHairline
'---actualise les barres de défilement---
With Me.UsedRange: End With
[A1].Select
End Sub
Nota : dans "Bilan Monétaire" les formats Nombre et Pourcentage doivent être appliqués aux colonnes entières.

Bonne journée.
 

Pièces jointes

  • Bilan(1).zip
    120.8 KB · Affichages: 62
Vote positif 0 Vote négatif
an@s

an@s

XLDnaute Occasionnel
Bonjour Job, le forum,
je vous remercie pour le code fourni, mais il y'a quelques remarques que je cite :

j'ai changé la première partie du code par :

VB: 
.[E2].Resize(nlig) = "=RC[4]-RC[7]-(RC[40]+RC[31]+RC[18])"
.[M2].Resize(nlig) = "=RC[-4]-RC[-1]"
.[N2].Resize(nlig) = "=RC[-2]+(RC[9]+RC[22]+RC[31])"
.[O2].Resize(nlig) = "=IFERROR(RC[-3]/RC[-1],"""")"
.[W2].Resize(nlig) = "=SUM(RC[-5]:RC[-1])"
.[AJ2].Resize(nlig) = "=SUM(RC[-12]:RC[-1])"
.[AS2].Resize(nlig) = "=SUM(RC[-8]:RC[-1])"

et comme vous pouvez constater sur le fichier joint, en appliquant votre code il a bien fait l'importation mais il n'a pas conservé les couleurs dans tout le tableau et il n'a pas conservé le pourcentage dans la colonne O
 

Pièces jointes

  • Bilan1.zip
    107 KB · Affichages: 58
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,

J'ai bien dit "D'après ce que je comprends" mais je ne suis pas devin, il faut être plus clair dans vos demandes.

En particulier pourquoi y a-t-il 2 types de formules dans chacune des colonnes E M N AS ?

Pour les couleurs je ne vois pas, le code conserve les couleurs des lignes telles qu'elles étaient avant l'importation.

Il n'est pas possible (ou plutôt c'est trop compliqué) de colorer les lignes nouvelles.

Pour la colonne O le code met une formule mais la remplace par une valeur s'il n'y avait pas de formule.

A+
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,

Bon puisqu'apparemment vous modifiez (manuellement ???) des formules après l'importation :
Code: 
Private Sub CommandButton1_Click()
Dim ncol%, nlig&, t, nlig1&, P As Range, d As Object, i&, P1 As Range, x$, j&
ncol = 45 'nombre de colonnes du tableau, adaptable
Application.ScreenUpdating = False
With Workbooks.Open(ThisWorkbook.Path & "\Matrice.xlsx").Sheets("MNT")
  nlig = .Range("C" & .Rows.Count).End(xlUp).Row
  If nlig > 1 Then nlig = nlig - 1
.[E2].Resize(nlig) = "=RC[4]-RC[7]-(RC[40]+RC[31]+RC[18])"
.[M2].Resize(nlig) = "=RC[-4]-RC[-1]"
.[N2].Resize(nlig) = "=RC[-2]+(RC[9]+RC[22]+RC[31])"
.[O2].Resize(nlig) = "=IFERROR(RC[-3]/RC[-1],"""")"
.[W2].Resize(nlig) = "=SUM(RC[-5]:RC[-1])"
.[AJ2].Resize(nlig) = "=SUM(RC[-12]:RC[-1])"
.[AS2].Resize(nlig) = "=SUM(RC[-8]:RC[-1])"
t = .[A2].Resize(nlig, ncol).FormulaR1C1
  .Parent.Close False
End With
'---restitution des valeurs et formules du 1er tableau---
nlig1 = Range("C" & Rows.Count).End(xlUp).Row + 2
With [A3].Resize(nlig1, ncol)
  .Borders.LineStyle = xlNone 'supprime les bordures
  .Copy [A3].Offset(, ncol) 'sauvegarde TOUT le tableau vers la droite
  .Delete xlUp 'RAZ
End With
Set P = [A3].Resize(nlig, ncol)
P = t
'---liste des "Hiérarchie OTP" du 1er tableau (sans doublon)---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To nlig
  If t(i, 3) <> "" Then d(t(i, 3)) = i 'repère la ligne
Next i
'---copie les lignes du 2ème tableau vers le 1er---
Set P1 = [A3].Offset(, ncol).Resize(nlig1, ncol)
For i = 1 To nlig1
  x = P1(i, 3)
  If x <> "" And d.Exists(x) Then
    j = d(x)
    P(j, "E") = P1(i, "E").FormulaR1C1
    P(j, "M") = P1(i, "M").FormulaR1C1
    P(j, "N") = P1(i, "N").FormulaR1C1
    P(j, "O") = P1(i, "O").FormulaR1C1
    P(j, "W") = P1(i, "W").FormulaR1C1
    P(j, "AJ") = P1(i, "AJ").FormulaR1C1
    P(j, "AS") = P1(i, "AS").FormulaR1C1
    P1.Rows(i).Copy
    P(j, 1).PasteSpecial xlPasteFormats 'copie les couleurs
  End If
Next i
P1.EntireColumn.Delete 'RAZ
'---bordures---
P.Borders(xlEdgeLeft).Weight = xlThin
P.Borders(xlEdgeTop).Weight = xlThin
P.Borders(xlEdgeRight).Weight = xlThin
P.Borders(xlEdgeBottom).Weight = xlMedium 'pourquoi pas...
P.Borders(xlInsideVertical).Weight = xlThin
P.Borders(xlInsideHorizontal).Weight = xlHairline
'---actualise les barres de défilement---
With Me.UsedRange: End With
[A1].Select
End Sub
Fichier (2).

A+
 

Pièces jointes

  • Bilan(2).zip
    120.5 KB · Affichages: 67
Vote positif 0 Vote négatif
an@s

an@s

XLDnaute Occasionnel
Re Job,
au fait je viens de découvrir le problème...comme vous pouvez remarque sur le fichier joint
  • quand on change les informations des colonnes C & D (fichier Matrice) une fois on fait l'importation on perd les couleurs d'origine,
  • si on garde les mêmes informations on perd pas les couleurs mais la ligne ajoutée ne prend aucune couleur alors que normalement elle doit prendre la couleur de la ligne de dessus
et comme je dois changer les informations entre plusieurs sociétés je perdrai les couleurs a chaque fois j'importe d'autres informations :(
 

Pièces jointes

  • Bilan 3.zip
    107 KB · Affichages: 55
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,

an@s à dit:
si on garde les mêmes informations on perd pas les couleurs mais la ligne ajoutée ne prend aucune couleur alors que normalement elle doit prendre la couleur de la ligne de dessus
Cliquez pour agrandir...
Oui comme je l'ai dit au post #21.

Arrangez-vous pour ne pas avoir à modifier les textes en colonne C qui servent de repère dans la macro.

Maintenant pour les couleurs des nouvelles lignes il faudra les appliquer manuellement ou faire une usine à gaz.

A+
 
Vote positif 0 Vote négatif
an@s

an@s

XLDnaute Occasionnel
re,
les textes en colonne C changent vu que je gère plusieurs projets, et la colonne C comme elle concerne les imputations elle diffère d'un projet à un autre... il n y'a pas une autre solution pour conserver les couleurs même si les informations de la colonne C changent???
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,

La solution simple c'est de colorer manuellement les lignes nouvelles par Copier/Collage spécial-Formats.

Au post #22 je vous demandais si les formules étaient modifiées manuellement.

Si c'est le cas ça ne prendra guère plus de temps de colorer les lignes nouvelles.

A+
 
Vote positif 0 Vote négatif
an@s

an@s

XLDnaute Occasionnel
re,
le problème c'est que pour importer les imputations d'un nouveau projet toutes les lignes perdront leur couleur et ca va prendre assez de temps pour les colorer manuellement :(

les formules ont une liaison avec le code de recalcule de la matrice
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,

Un nouveau projet n'a donc plus rien à voir avec l'ancien.

A votre place je simplifierai le fichier en ne mettant aucune couleur aux lignes "standard".

A vouloir trop bien faire on crée des usines à gaz sans grand bénéfice.

A+
 
Vote positif 0 Vote négatif
an@s

an@s

XLDnaute Occasionnel
Re,
Les projets ont presques les mêmes postes la différence c'est dans les imputations et les appelations, donc si je veux les changer manullement ca va prendre assez de temps...

Je pensais qu' il y aura une solution pour garder les couleurs même apres importation de données differente de la colonne C :(

EDIT: les couleurs d'entête ont une liaison avec le code de recalcule, et ça me permet de distinguer les grands poste de chaque ouvrage..c'est important

j'espère que vous trouverez une méthode pour pouvoir conserver les couleurs même après changement de données dans la colonne C
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour an@s, le forum,

Avec cette version (3), on peut modifier la colonne D, les données d'origine sont mémorisées en colonne A (masquée) :
Code: 
Private Sub CommandButton1_Click()
Dim ncol%, nlig&, t, nlig1&, P As Range, d As Object, i&, P1 As Range, x$, j&
ncol = 46 'nombre de colonnes du tableau, la colonne A est masquée
Application.ScreenUpdating = False
With Workbooks.Open(ThisWorkbook.Path & "\Matrice.xlsx").Sheets("MNT")
  .[A:A].Insert 'ajout d'une colonne
  nlig = .Range("D" & .Rows.Count).End(xlUp).Row
  If nlig > 1 Then nlig = nlig - 1
  .[A2].Resize(nlig) = .[D2].Resize(nlig).Value '"Hiérarchie OTP" copié en colonne A
  .[F2].Resize(nlig) = "=RC[4]-RC[7]-(RC[40]+RC[31]+RC[18])"
  .[N2].Resize(nlig) = "=RC[-4]-RC[-1]"
  .[O2].Resize(nlig) = "=RC[-2]+(RC[9]+RC[22]+RC[31])"
  .[P2].Resize(nlig) = "=IFERROR(RC[-3]/RC[-1],"""")"
  .[X2].Resize(nlig) = "=SUM(RC[-5]:RC[-1])"
  .[AK2].Resize(nlig) = "=SUM(RC[-12]:RC[-1])"
  .[AT2].Resize(nlig) = "=SUM(RC[-8]:RC[-1])"
  t = .[A2].Resize(nlig, ncol).FormulaR1C1
  .Parent.Close False
End With
'---restitution des valeurs et formules du 1er tableau---
nlig1 = Range("D" & Rows.Count).End(xlUp).Row + 2
With [A3].Resize(nlig1, ncol)
  .Borders.LineStyle = xlNone 'supprime les bordures
  .Copy [A3].Offset(, ncol) 'sauvegarde TOUT le tableau vers la droite
  .Delete xlUp 'RAZ
End With
Set P = [A3].Resize(nlig, ncol)
P = t
'---liste des "Hiérarchie OTP" du 1er tableau (sans doublon)---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To nlig
  If t(i, 1) <> "" Then d(t(i, 1)) = i 'repère la ligne
Next i
'---copie les lignes du 2ème tableau vers le 1er---
Set P1 = [A3].Offset(, ncol).Resize(nlig1, ncol)
For i = 1 To nlig1
  x = IIf(P1(i, 1) = "", P1(i, "D"), P1(i, 1)) '"Hiérarchie OTP" d'origine
  If x <> "" And d.Exists(x) Then
    j = d(x)
    Union(P(j, 1), P(j, "D")) = P1(i, "D") '"Hiérarchie OTP" modifiées
    P(j, "F") = P1(i, "F").FormulaR1C1
    P(j, "N") = P1(i, "N").FormulaR1C1
    P(j, "O") = P1(i, "O").FormulaR1C1
    P(j, "P") = P1(i, "P").FormulaR1C1
    P(j, "X") = P1(i, "X").FormulaR1C1
    P(j, "AK") = P1(i, "AK").FormulaR1C1
    P(j, "AT") = P1(i, "AT").FormulaR1C1
    P1.Rows(i).Copy
    P(j, 1).PasteSpecial xlPasteFormats 'copie les couleurs
  End If
Next i
P1.EntireColumn.Delete 'RAZ
'---bordures---
P.Borders(xlEdgeLeft).Weight = xlThin
P.Borders(xlEdgeTop).Weight = xlThin
P.Borders(xlEdgeRight).Weight = xlThin
P.Borders(xlEdgeBottom).Weight = xlMedium 'pourquoi pas...
P.Borders(xlInsideVertical).Weight = xlThin
P.Borders(xlInsideHorizontal).Weight = xlHairline
'---actualise les barres de défilement---
With Me.UsedRange: End With
[B1].Select
End Sub
J'espère que c'est ce que vous voulez.

A+
 

Pièces jointes

  • Bilan(3).zip
    129.3 KB · Affichages: 68
Vote positif 0 Vote négatif

Discussions similaires

J
  • Question
XL 2021 SOMME INDIRECT AVEC PLUSIEUR CONDITIONS
Réponses
4
Affichages
144
Jimmy_fidu
J
L
  • Résolu(e)
Microsoft 365 Création d'un code VBA pour sélectionner des zone selon choix multiples.
Réponses
3
Affichages
149
Lionel Alfred
L
A
  • Résolu(e)
Microsoft 365 Correction d'un code vba
2
Réponses
22
Affichages
794
AD95
A
7
  • Résolu(e)
XL 2016 Formule pour calculer un index et la date de la précédente relève pour un suivi des consommations
Réponses
2
Affichages
201
7outils
7
S
  • Résolu(e)
XL 2016 Besoin d'aide pour un code d'extraction
Réponses
14
Affichages
285
Phil69970
Phil69970
E
  • Question
Besoin d'une formule pour résoudre un tableau
2
Réponses
15
Affichages
577
Dudu2
Dudu2
C
  • Question
XL 2021 Etat de sortie sur Word a partir d'une base Excel
Réponses
11
Affichages
613
cherco
C
E
  • Résolu(e)
Microsoft 365 recherchex dans plusieurs colonnes non contigues
Réponses
4
Affichages
310
eric72
E
E
  • Question
Microsoft 365 Fonction de decalage de cellule vers le bas
Réponses
14
Affichages
328
Cousinhub
Cousinhub
6
  • Question
XL 2019 Générer mails sous conditions
2
Réponses
26
Affichages
521
Oneida
Oneida

Membres actuellement en ligne

3 membres et 35 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 348
Messages
2 087 508
Membres
103 568
dernier inscrit
NoS