Macro : Supprimer lignes doubles sous conditions

[roidurif]

Bonjour,

Je souhaite faire une macro qui supprimes des lignes a deux conditions :
- Supprimer les références produits en doubles si c'est le même PRIX HT que les précédentes.
- Supprimer les lignes lorsqu'il y' a "A" colonne B

Merci de votre aide

 

[mth]

Re : Macro : Supprimer lignes doubles sous conditions

Bonsoir,

puisqu'on parle doublons, je ne résiste pas au plaisir de te montrer ce lien: ICI, .... sublime 🙂

bonne soirée,

mth

 

[roidurif]

Re : Macro : Supprimer lignes doubles sous conditions

Merci mais c pas exactement ce ke je recherche, c plutôt une macro simple

merci

 

[roidurif]

Re : Macro : Supprimer lignes doubles sous conditions

Re, bonjour

Si quelqu'un peu m 'eclaircir svp?

cordialement

 

[BOISGONTIER]

Re : Macro : Supprimer lignes doubles sous conditions

Bonjour,

Sub GardeDernier()
  Set MonDico = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  i = [A65000].End(xlUp).Row
  Do While i > 2
    temp = Cells(i, "C")
    If Not MonDico.Exists(temp) Then
      MonDico.Add temp, temp
      i = i - 1
    Else
      Rows(i).EntireRow.Delete
      i = i - 1
    End If
  Loop
End Sub

Sub GardePremier()
  Set MonDico = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  i = 2
  Do While i < [A65000].End(xlUp).Row
    temp = Cells(i, "C")
    If Not MonDico.Exists(temp) Then
      MonDico.Add temp, temp
      i = i + 1
    Else
      Rows(i).EntireRow.Delete
    End If
  Loop
End Sub

Sub supA()
    [B2:B65000].SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
End Sub

JB
Formation Excel VBA JB

 

[roidurif]

Re : Macro : Supprimer lignes doubles sous conditions

Bonjour BOISGONTIER,

Merci pour ton code, mais je viens de tester et je vois que ça supprime toutes les références produits en doubles;
Mais Par contre je ne pensais pas que ça aller tout supprimer, même les références produits en doubles avec un PRIX HT différents des précédentes. Alors que ça ne doit pas le faire.

J'espère que je m'exprime bien.

Merci pas avance et votre aide

Sub GardeDernier()
  Set MonDico = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  i = [A65000].End(xlUp).Row
  Do While i > 2
    temp = Cells(i, "C")
    If Not MonDico.Exists(temp) Then
      MonDico.Add temp, temp
      i = i - 1
    Else
      Rows(i).EntireRow.Delete
      i = i - 1
    End If
  Loop
End Sub

Sub GardePremier()
  Set MonDico = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  i = 2
  Do While i < [A65000].End(xlUp).Row
    temp = Cells(i, "C")
    If Not MonDico.Exists(temp) Then
      MonDico.Add temp, temp
      i = i + 1
    Else
      Rows(i).EntireRow.Delete
    End If
  Loop
End Sub

Sub supA()
    [B2:B65000].SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
End Sub

Cordialement

 

[BOISGONTIER]

Re : Macro : Supprimer lignes doubles sous conditions

Bonsoir,

Sub GardeDernier()
  Set MonDico = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  i = [A65000].End(xlUp).Row
  Do While i > 2
    temp = Cells(i, "C") & Cells(i, "AH")
    If Not MonDico.Exists(temp) Then
      MonDico.Add temp, temp
      i = i - 1
    Else
      Rows(i).EntireRow.Delete
      i = i - 1
    End If
  Loop
End Sub

Sub GardePremier()
  Set MonDico = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  i = 2
  Do While i < [A65000].End(xlUp).Row
    temp = Cells(i, "C") & Cells(i, "AH")
    If Not MonDico.Exists(temp) Then
      MonDico.Add temp, temp
      i = i + 1
    Else
      Rows(i).EntireRow.Delete
    End If
  Loop
End Sub

JB

 

[roidurif]

Re : Macro : Supprimer lignes doubles sous conditions

Bonsoir BOISGONTIER,

Merci infiniment,
Dites si je veux lancer la macro à partir de la "feuil1", comment dois je procéder?
J'ai fait cela, mais ça n'a pas l'air de fonctionner

Sub GardePremier()
  With Sheets("BDD")
  Set MonDico = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  i = 2
  Do While i < Sheets("BDD").[A65000].End(xlUp).Row
    temp = Sheets("BDD").Cells(i, "C") & Cells(i, "AH")
    If Not MonDico.Exists(temp) Then
      MonDico.Add temp, temp
      i = i + 1
    Else
      Rows(i).EntireRow.Delete
    End If
  Loop
  End With
  Call Supression_lignes_A
End Sub



Sub Supression_lignes_A()

With Sheets("BDD")
    [B2:B65000].SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
End With
End Sub

merci d'avance

 

[BOISGONTIER]

Re : Macro : Supprimer lignes doubles sous conditions

Bonsoir,

Sub GardeDernier()
  Set f = Sheets("bdd")
  Set MonDico = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  i = f.[A65000].End(xlUp).Row
  Do While i > 2
    temp = f.Cells(i, "C") & f.Cells(i, "AH")
    If Not MonDico.Exists(temp) Then
      MonDico.Add temp, temp
      i = i - 1
    Else
      f.Rows(i).EntireRow.Delete
      i = i - 1
    End If
  Loop
End Sub

Sub GardePremier()
  Set f = Sheets("bdd")
  Set MonDico = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  i = 2
  Do While i < f.[A65000].End(xlUp).Row
    temp = f.Cells(i, "C") & f.Cells(i, "AH")
    If Not MonDico.Exists(temp) Then
      MonDico.Add temp, temp
      i = i + 1
    Else
      f.Rows(i).EntireRow.Delete
    End If
  Loop
End Sub

Sub supA()
   Set f = Sheets("bdd")
   f.[B2:B65000].SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
End Sub

JB

 

[roidurif]

Re : Macro : Supprimer lignes doubles sous conditions

Merci BOISGONTIER,

Je me retrouve avec un cas où dans la colonne "B" est vide, la macro Sub supA() bloque.
J'ai ajouter ceci : If f.[B2:B65000] = Null Then Exit Sub
mais encore une fois je fais appel a votre aide, car j'ai du faire qq chose de pas bon

Sub supA()
   Set f = Sheets("bdd")
   If f.[B2:B65000] = Null Then Exit Sub
   f.[B2:B65000].SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
End Sub

Merci par avance

Cordialement

 

[job75]

Re : Macro : Supprimer lignes doubles sous conditions

Bonsoir roidurif, JB,

Là JB tu descends dans l'arène 🙂

A+

 

[BOISGONTIER]

Re : Macro : Supprimer lignes doubles sous conditions

Sub supA()
   Set f = Sheets("bdd")
   On Error Resume Next
   f.[B2:B65000].SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
End Sub

JB