trier et éffacer cellule

[yvon07]

Bonjour a tous
en espérant qu'une âme charitable pourras m'aider.
feuille 1 une liste que j'utilise pour autre chose
feuille 2 un export,2 fois par jour
se que je veux faire repérer ,les réf. de ma liste qui se trouve dans mon export
et effacer les autres ,sur la feuille 1.pour pouvoir les utilisé pour la suite de mon fichier
je sait les repérer avec une MFC, mais comment supprimer.
Encore merci d'avance pour votre aide

 

[yvon07]

Re : trier et éffacer cellule

Bonjour
autre petit problème
Je désir dans la macro effacer ,pouvoir inserer l'une des trois cellule L7-M7 ou N7"ref +image"
selon que la ref se trouve dans la colonne A de la feuille 1
une seul des réf sera présente, jamais les trois ensembles.
Milles merci
Slts

 

[yvon07]

Re : trier et éffacer cellule

bonjour
je ne suis pas sur de m'être bien exprimé.
j'ai re expliqué dans le fichier joint, se que je désir faire.
Encore merci, a qui pourras m'aider
Mes Salutations

 

[job75]

Re : trier et éffacer cellule

Bonjour yvon07,

Sub Effacer()
Dim P As Range, t1, t2, d As Object, s As Shape
Set P = Feuil1.[A1:A147] 'à adapter
t1 = P 'matrice, plus rapide
t2 = Feuil2.[K2:K214] 'à adapter
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t2)
  d(t2(i, 1)) = ""
Next
For i = 1 To UBound(t1)
  If Not d.exists(t1(i, 1)) Then t1(i, 1) = ""
Next
P = t1
'---copie l'image---
Application.CopyObjectsWithCells = True 'si nécessaire
With Feuil3 'CodeName de la feuille
  .[B7] = ""
  For Each s In .Shapes
    If s.TopLeftCell.Address = .[B7].Address Then s.Delete
  Next
  For Each s In .Shapes
    If Application.CountIf(P, s.TopLeftCell) Then s.TopLeftCell.Copy .[B7]: Exit For
  Next
End With
End Sub

A+

 

[yvon07]

Re : trier et éffacer cellule

Bonsoir JOB75
merci pour tout, c'est exactement se que je voulais.
je vais essayer de terminer mon fichier au complet.
encore merci
A plus


.

 

[yvon07]

Re : trier et éffacer cellule

bonsoir
Nouveau problème, lorsque j 'exécute la macro dans mon fichier au lieu de me copier l'une des cellules en colonne L,M ou K
il me copie des images qui sont dans d'autres cellules entre les colonne A à L Dont la réf n'a pas de rapport.
de plus la ou je veut copier ,se sont trois cellules fusionné, cela fait "beuguer" la macro.
en espérant avoir de l'aide votre part.
Merci d'avance
Mes Sincères salutations

 

[job75]

Re : trier et éffacer cellule

Bonsoir,

Ma solution fonctionne sur le fichier du post #17.

Joignez donc un fichier représentatif de vos nouveaux problèmes.

A+

 

[yvon07]

Re : trier et éffacer cellule

bonsoir
Est encore merci pour votre patience
j'espère que le fichier pourras faire, j'ai dut supprimer pas mal de chose pour l'alléger.
il y a aussi le pb de la deuxième cellule ou si l'on trouve une des trois ref,on doit copier l'intégralité,de celle-ci, dans la cellule violette, qui est fusionner.
Bonne soirée

 

[job75]

Re : trier et éffacer cellule

Bonsoir,

Est encore merci pour votre patience

Sympa mais ma patience a des limites, je vous laisse vous débrouiller avec votre usine à gaz.

Bonne nuit.

 

[job75]

Re : trier et éffacer cellule

Bonjour yvon07,

Ma patience se reconstitue la nuit :

Sub trier()
Dim P As Range, t1, t2, d As Object, cible As Range, o As Object, a, i%, nom$
Set P = Feuil1.[A1:A147] 'à adapter
t1 = P 'matrice, plus rapide
t2 = Feuil2.[K2:K214] 'à adapter
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t2)
  d(t2(i, 1)) = ""
Next
For i = 1 To UBound(t1)
  If Not d.exists(t1(i, 1)) Then t1(i, 1) = ""
Next
P = t1
'---copie l'image---
Application.CopyObjectsWithCells = True 'si nécessaire
Application.ScreenUpdating = False
With Feuil3 'CodeName de la feuille
  Set cible = .[A2].MergeArea
  cible.Clear 'efface tout, y compris la fusion
  On Error Resume Next 'si l'image n'existe pas
  .Shapes("MaJolieShape").Delete
  On Error GoTo 0
  For Each o In .DrawingObjects
    If Not Intersect(o.TopLeftCell, .[L2:N2]) Is Nothing Then
      a = Split(o.TopLeftCell, vbLf)
      For i = 0 To UBound(a)
        If Application.CountIf(P, Trim(a(i))) Then
          nom = o.Name 'mémorise le nom
          o.Name = "MaJolieShape"
          o.TopLeftCell.Copy cible(1)
          o.Name = nom
          cible.Merge
          cible(1) = o.TopLeftCell 'si formule
          '---cadrage---
          Set o = .Shapes("MaJolieShape")
          o.Left = cible.Left + (cible.Width - o.Width) / 2
          Exit Sub
        End If
      Next
    End If
  Next
  cible.Merge
End With
End Sub

Testé uniquement sur Excel 2003 pour l'instant.

Bonne journée.

 

[yvon07]

Re : trier et éffacer cellule

bonsoir
on y est presque, ceci marche très bien avec les cellules L2 et N2.mais pas avec M2 car je pense qu'il y a trois réf de marqué, alors que dans l'export ces trois réf sont dans des cellules distinct.
Je suis désolé d'user votre patience.
Mais je vous remercie, milles fois pour votre aide.
Salutations

 

[job75]

Re : trier et éffacer cellule

Re,

on y est presque, ceci marche très bien avec les cellules L2 et N2.mais pas avec M2 car je pense qu'il y a trois réf de marqué

Je me demande bien sur quoi vous testez... Ci-joint votre fichier avec ma macro.

Fonctionne sur Excel 2003 et Excel 2010.

A+

 

[yvon07]

Re : trier et éffacer cellule

je ne comprend pas, effectivement la ca marche
le fichier original est le même en plus important,
Seul A2 devient A8
L2 M2 N2 deviennent L8 M8 N8
ces cellules sont exactement celles de mon fichier
il n'y a que celle a trois ref qui coince dans mon fichier, avec les deux autres ca fonctionne très bien.
A+

 

[yvon07]

Re : trier et éffacer cellule

j'ai trouvé,je pense qu'il y avait un problème sur la mise en forme dans ma base, puis j'ai mis les trois réf.la ca fonctionne.
lundi, je teste en situation réel.
je vous tient au courant.
Encore merci.
A+

 

[yvon07]

Re : trier et éffacer cellule

bonsoir
Merci JOB75.
Pour le tri tous est ok, maintenant je bloque sur l'enregistrement du fichier.
aimerai enregistrer ,en cliquant sur ce bouton, le document dans un dossier nommé "TdB",ou ce fichier "model" se trouve.
sous la forme "10/2/2015 1853689 st paul"
et recopier ceci dans la feuille base, du fichier model, pour pouvoir faire une recherche éventuel.
Si quelqu'un peu m'aider, merci d'avance.
A+

 

[job75]

Re : trier et éffacer cellule

Bonsoir yvon07,

Ce n'est plus vraiment le sujet de ce fil mais bof

Il faut savoir qu'il y a des caractères interdits pour les noms des fichiers.

Le slash "/" en est un.

Donc voyez cette macro :

Sub Enregistrer()
Dim chemin$, c As Range, fichier$
chemin = ThisWorkbook.Path & "\"
Set c = Sheets("export").Range("A" & Rows.Count).End(xlUp)
fichier = Format(Date, "dd-mm-yyyy ") & c & " " & c(, 2) '???
Application.DisplayAlerts = False 'si le fichier a déjà été créé
On Error Resume Next
Workbooks(fichier).Close 'si le fichier est ouvert on le ferme
On Error GoTo 0
Sheets("armoire").Copy 'nouveau document
ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value 'facultatif, supprime les formules
ActiveWorkbook.SaveAs chemin & fichier
ActiveWorkbook.Close
Sheets("base").Range("A" & Rows.Count).End(xlUp)(2) = fichier
End Sub

A+