Signaler

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

Posez votre question agathe182 49Messages postés mercredi 24 août 2016Date d'inscription 26 septembre 2016 Dernière intervention - Dernière réponse le 26 sept. 2016 à 17:31
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
Afficher la suite 
Utile
+0
moins plus
Up :)
Ajouter un commentaire
Utile
+0
moins plus
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_m 13957Messages postés lundi 12 septembre 2005Date d'inscription ContributeurStatut 27 septembre 2016 Dernière intervention - 23 sept. 2016 à 10:43
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
Répondre
agathe182 49Messages postés mercredi 24 août 2016Date d'inscription 26 septembre 2016 Dernière intervention - 23 sept. 2016 à 17:13
Super Merci ! je teste ça !
Répondre
agathe182 49Messages postés mercredi 24 août 2016Date d'inscription 26 septembre 2016 Dernière intervention - 26 sept. 2016 à 10:38
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...
Répondre
michel_m 13957Messages postés lundi 12 septembre 2005Date d'inscription ContributeurStatut 27 septembre 2016 Dernière intervention - 26 sept. 2016 à 12:03
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
Répondre
agathe182 49Messages postés mercredi 24 août 2016Date d'inscription 26 septembre 2016 Dernière intervention - 26 sept. 2016 à 12:22
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
Répondre
Ajouter un commentaire
Utile
+0
moins plus
on s'est croisé, voir + haut ;o)
agathe182 49Messages postés mercredi 24 août 2016Date d'inscription 26 septembre 2016 Dernière intervention - 26 sept. 2016 à 13:59
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.
Répondre
Ajouter un commentaire
Utile
+0
moins plus
Voir
http://www.commentcamarche.net/forum/affich-33941482-mfc-par-rapport-au-chiffre-contenu-dans-la-cellule-d-une-colonne#p33942482
agathe182 49Messages postés mercredi 24 août 2016Date d'inscription 26 septembre 2016 Dernière intervention - 26 sept. 2016 à 17:31
Ok bah tant pis je vais essayer de me débrouiller autrement..
J'ai juste pas compris le code que tu voulais me donner.
Répondre
Ajouter un commentaire

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !