Macro copier/remplacer ligne sous condition [Résolu/Fermé]

Signaler
Messages postés
49
Date d'inscription
mercredi 24 août 2016
Statut
Membre
Dernière intervention
26 septembre 2016
-
Messages postés
49
Date d'inscription
mercredi 24 août 2016
Statut
Membre
Dernière intervention
26 septembre 2016
-
Bonjour,

J'ai un code qui me permet de comparer deux feuilles excel de la manière suivante par rapport à trois variables dans les colonnes I, P, R :
- Si la ligne qui se trouve dans la feuille A se trouve aussi dans la feuille B, la ligne est remplacée sur la feuille B,
-Si la ligne qui se trouve dans la feuille A, ne se trouve pas dans la feuille B, la ligne est rajoutée à la fin de la feuille B.

Le problème, c'est que je ne souhaite plus que la ligne entière soit remplaçée parce que j'ai une colonne où j'entre des commentaires, et j'aimerai faire le remplacement ou la copie des cellules de cette ligne à partir de la colonne E à AL mais pas de toute la ligne....

Voici mon code :

Option Explicit

Public Const FM As String = "Launch Tracker"
Public Const lidebFM As Byte = 3

Public Const FL As String = "LAT - Master Data"
Public Const lidebFL As Byte = 3

Public Const co1 As Byte = 9 ' colonne I
Public Const co2 As Byte = 16 ' colonne P
Public Const co3 As Byte = 18 ' colonne R

Public Sub Update()
Dim lifinFL As Long, liFL As Long
Dim lifinFM As Long, liFM As Long
Dim obj As Object
Dim V1 As String, V2 As String, V3 As String
With Sheets(FL)
' dernière ligne feuille FL
lifinFL = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
' boucle sur les lignes de FL
For liFL = lidebFL To lifinFL
' dernière ligne de FM
lifinFM = Sheets(FM).Cells.Find("*", , , , xlByRows, xlPrevious).Row
' comparaison des Item ID
V1 = .Cells(liFL, co1).Value
' recherche de V1 dans FM colonne co1
Set obj = Sheets(FM).Columns(co1).Find(V1, , , xlWhole)
' si pas trouve lifm = 1° ligne dispo dans FM pour copie
If obj Is Nothing Then
liFM = lifinFM + 1
' sinon V1 est trouve à la ligne liFM
Else
liFM = obj.Row
' compraison de MARKET et SAP
V2 = .Cells(liFL, co2).Value
V3 = .Cells(liFL, co3).Value
' si identiques on garde liFM = liobj pour ecrasement
If V2 = Sheets(FM).Cells(liFM, co2).Value And V3 = Sheets(FM).Cells(liFM, co3).Value Then
' rien
Else
' si non identiques lifm = 1° ligne dispo dans FM pour copie
liFM = lifinFM + 1
End If
End If
' copie de la ligne liFL dans FM à la ligne liFM
.Rows(liFL).Copy Sheets(FM).Cells(liFM, 1)
Next liFL
End With

End Sub


Est-ce qu'une personne aurait l'amabilité de m'aider ?

Cordialement,

Agathe

4 réponses

Messages postés
49
Date d'inscription
mercredi 24 août 2016
Statut
Membre
Dernière intervention
26 septembre 2016

Up :)
Messages postés
16250
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
19 octobre 2020
3 051
Bonjour,

l'action se fait bien sur les 3 valeurs I, P,R ?
type de données dans ces 3 colonnes : texte,nombre, date....etc ?
Nombre de lignes à traiter ?
FM est elle bien la feuille "A3 ?

si on ne trouve pas IPR dans la feuille on ne copie quand m^me que E à AL ?
sinon, toute le ligne jusqu'à dernière colonne du tableau source (AL?)

merci d'avance mais guère de temps aujourd'hui...

au besoin
Mettre un extrait du classeur sans données confidentielles en pièce jointe sur http://cjoint.com/
et
coller le raccourci par un clic droit sur le lien proposé dans le message de réponse


Car en VBA je n'aime pas du tout travailler à l'aveugle...
Dans l’attente



 Michel
Messages postés
16250
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
19 octobre 2020
3 051
Bonjour,

ci dessous code proposé
mise à jour en en 0,8 secondes pour env 1800 lignes
Option Explicit
Option Base 1
Dim Ttrak_concat, Tdata_concat, Derlig As Integer
'---------------------------------------------------------------
Sub mettre_a_jour()
Dim Cptr As Integer, D_concat As Object, Ref As String
Dim Ligne As Integer, Lig As Integer
Dim Start As Single
Dim test 'pour essais

Start = Timer
Application.ScreenUpdating = False
Call concatener("LAT - Master Data", Tdata_concat)
Call concatener("Launch Tracker", Ttrak_concat)

'creation d'une collection: concaténation - ligne dans tracker
Set D_concat = CreateObject("scripting.dictionary")
For Cptr = 1 To UBound(Ttrak_concat)
Ref = Ttrak_concat(Cptr, 1)
If Not D_concat.exists(Ref) Then: D_concat.Add Ref, Ttrak_concat(Cptr, 2)
Next

'comparaison entre les feuilles
For Cptr = 1 To UBound(Tdata_concat)
Ref = Tdata_concat(Cptr, 1) 'chaineIPR feuil data
Ligne = Tdata_concat(Cptr, 2) 'localisation feuil data
If D_concat.exists(Ref) Then
Lig = D_concat.Item(Ref) 'localisation feuil track
Else
Lig = Derlig + 1
End If
Sheets("LAT - Master Data").Range(Cells(Ligne, "E"), Cells(Ligne, "AL")).Copy _
Sheets("Launch Tracker").Cells(Lig, "E")
Next

Sheets("Launch Tracker").Activate
Application.ScreenUpdating = False
MsgBox "mise à jour réalisée en: " & Round(Timer - Start, 2) & " secondes"
End Sub

'---------------------------------------
Sub concatener(Feuille, Tablo)
Dim T_coli, T_colp, T_colr, Cptr As Integer
Dim test
With Sheets(Feuille)
'mémorisation des colonnes I P R
Derlig = .Columns("I").Find(what:="*", searchdirection:=xlPrevious).Row
T_coli = Application.Transpose(.Range("I3:I" & Derlig))
T_colp = Application.Transpose(.Range("P3:P" & Derlig))
T_colr = Application.Transpose(.Range("R3:R" & Derlig))
'concatène les données IPR pour comparaison
ReDim Tablo(UBound(T_colr), 2)
For Cptr = 1 To UBound(T_colr)
Tablo(Cptr, 1) = T_coli(Cptr) & " " & T_colp(Cptr) & " " & T_colr(Cptr)
Tablo(Cptr, 2) = Cptr + 2 'ligne de la concaténation
Next
End With

End Sub


cjoint n'accepte plus les classeurs avec macros et les transforme en xlsx et c'est le B...pour s'en servir

edit 10:55

tentative en transformant en xls
http://www.cjoint.com/c/FIxi1n2W2P2
ca marche
Messages postés
49
Date d'inscription
mercredi 24 août 2016
Statut
Membre
Dernière intervention
26 septembre 2016

Super Merci ! je teste ça !
Messages postés
49
Date d'inscription
mercredi 24 août 2016
Statut
Membre
Dernière intervention
26 septembre 2016

Hello,

Je ne parviens pas à utiliser le code...

Ca bug sur cette partie
        Sheets("LAT - Master Data").Range(Cells(Ligne, "E"), Cells(Ligne, "AL")).Copy _
Sheets("Launch Tracker").Cells(Lig, "E")


J'ai essayé de transformer
 Cells(Lig,"E")
en
 Cells(Ligne,"E")
parce que
 Lig 
n'était pas défini mais ça ne résouds pas le problème...
Messages postés
16250
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
19 octobre 2020
3 051 >
Messages postés
49
Date d'inscription
mercredi 24 août 2016
Statut
Membre
Dernière intervention
26 septembre 2016

bonjour
effectivement....

c'est curieux car j'avais fait des essais et ca marchait puisque je t'annonçais un temps...
ce n'est pas Ligne et Lig puisque l'égalité ligne3=lig21

j'essaierai de regarder en fin d'après midi ou certainement pas avant mercredi :o/

Edit: 12:30h

okay, je crois avoir compris
la formule ne marche que sur la feuille active!
sans doute que je lançais la macro à partir de master_data

  'comparaison entre les feuilles
Sheets("LAT - Master Data").Activate
For Cptr = 1 To UBound(Tdata_concat)
Ref = Tdata_concat(Cptr, 1) 'chaineIPR feuil data
Ligne = Tdata_concat(Cptr, 2) 'localisation feuil data
If D_concat.exists(Ref) Then
Lig = D_concat.Item(Ref) 'localisation feuil track
Else
Lig = Derlig + 1
End If

Range(Cells(Ligne, "E"), Cells(Ligne, "AL")).Copy _
Sheets("Launch Tracker").Cells(Lig, "E")
Next


tu dis si OK
d'avance merci
Messages postés
49
Date d'inscription
mercredi 24 août 2016
Statut
Membre
Dernière intervention
26 septembre 2016

Ah ah pas de souci, c'est super sympa de m'aider en tout cas...
C'est trop complexe pour que je trouve une solution toute seule
Messages postés
16250
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
19 octobre 2020
3 051
on s'est croisé, voir + haut ;o)
Messages postés
49
Date d'inscription
mercredi 24 août 2016
Statut
Membre
Dernière intervention
26 septembre 2016

La macro se lance bien mais ça ne fonctionne pas...
J'ai fait un test tout con en mettant la feuille launch tracker vide et en mettant 4 lignes dans LAT-Master Data et ça ne m'a rajouté qu'une ligne sur les 4. Par contre la ligne qui a été remplacée c'est top parce que ça ne copie qu'à partir de la colonne E.
Messages postés
16250
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
19 octobre 2020
3 051
Messages postés
49
Date d'inscription
mercredi 24 août 2016
Statut
Membre
Dernière intervention
26 septembre 2016

Ok bah tant pis je vais essayer de me débrouiller autrement..
J'ai juste pas compris le code que tu voulais me donner.