doublons et modif cellule+2

[mefis]

😕 bonjour à tous,
j'ai une liste de doublons a trouver dans ma feuille de données et je veux modifier la deuxieme cellule aprés la reference doublon en y inserant une date "01.01.2008"
est il posible d'avoir une combolist des doublons a rechercher tout en pouvant rajouter des reperes ou en supprimer
merci a tous

aprés quelques recherches sur le forum j'ai réussi a trouver une formule pour les doublons
par contre cette macro est lente, j'ai pourtant rajouté ce qu'il faut pour l'accélérer mais!!!!!
Je cherche le moyen de selectionner les cellules de gauche qel que soit les lignes de "doublon"
ramplacer: Range("O1726:O22873").Select par ????????????????????
Si quelqu'un a une solution

Ps:ne plus tenir compte du fichier joint


Sub doublons()
'
' doublons Macro
' Macro enregistrée le 04/07/2007 par MEFIS
'

'
Application.ScreenUpdating = False
Sheets("Feui1").Select
Range("A4😛4").Select
Range("P4").Activate
Selection.AutoFilter
Selection.AutoFilter
Range("P5").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(MATCH(RC[-14],donnees!R2C1:R30000C1,0)),"""",""Doublon"")"
Selection.AutoFill Destination:=Range("P5😛30000")
Range("P5😛30000").Select
Selection.AutoFilter Field:=16, Criteria1:="Doublon"

' MODIFIER LES CELLULES A GAUCHE DE DOUBLON

Range("O1726:O22873").Select
Selection.Find(What:="00.", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Selection.Replace What:="00.00.0000", Replacement:="01.01.2007", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False


Sheets("Feui1").Select

End Sub

 

[mefis]

Re : doublons et modif cellule+2

coucou,
help me

 

[mefis]

Re : doublons et modif cellule+2

Bonsoir A Tous,
Si Quelqu'un Pouvais M'aider
Merci D4avance

 

[mefis]

Re : doublons et modif cellule+2

bonsoir à tous,
je suis toujours en attente d'un coup de main sur ce sujet, j'ai beau tourner sur le forum je ne trouve pas de solution à mon problème
pouvez vous m'aider SVP

 

[Staple1600]

Re : doublons et modif cellule+2

Bonsoir



Pour un traitement rapide des doublons

Option Explicit
 
Sub DeleteDups()
  'Auteur: DRJ    
    Dim x               As Long
    Dim LastRow         As Long
 
    LastRow = Range("A65536").End(xlUp).Row
    For x = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountIf(Range("A1:A" & x),  _
Range("A" & x).Text) > 1 Then
            Range("A" & x).EntireRow.Delete
 
        End If
    Next x
 
End Sub

En espérant que cela puisse t'aider

En vagabondant sur le net une autre facon de traiter les doublons

Sub HighlightDuplicates()
'SOURCE:
'Groupes de discussion : [B]microsoft.public.excel.programming[/B]
'De : Leith Ross
'Date : Thu, 29 Jun 2006 23:35:45 -0500
'Local : Ven 30 juin 2006 06:35
'Objet:  Re: Highlight duplicates
'/////////////////////////////////
  'Highlight duplicates in Yellow
  Dim Cell As Range
  Dim Cell_Range As Range
  Dim MyCollection As New Collection
  'Find last cell entry in the row
  LastEntry = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Address
  'Define the range to examine
  Set Cell_Range = ActiveSheet.Range("A1", LastEntry)
  For Each Cell In Cell_Range
  On Error Resume Next
  MyCollection.Add Item:="1", Key:=Cell.Text
  If Err.Number = 457 Then
  Cell.Interior.ColorIndex = 6
  Cell.Offset(, 1).Value = "doublons"
  Err.Clear
  End If
  Next Cell
  End Sub

 

[mefis]

Re : doublons et modif cellule+2

Merci staple1600 pour ton aide,
je ne reprends le weeb que maintenant, j'ai testé ta macro en la modifiant légèrement mais je ne m'en sort pas, je deviens dingue.


je veux qu'elle compare la (colonne A) de la feuille "doublons" à la feuille "base" (colonne B) et quand elle en trouve un qu'elle m'insere 01.01.2005 dans la cellule sur la meme ligne (colonne O) mais je n'y arrive pas

si quelqu'un a la solution
mlerci d'avance



Sub ajourner_les_doublons()
'
'Highlight duplicates in Yellow
Dim Cell As Range
Dim Cell_Range As Range
Dim MyCollection As New Collection
'Find last cell entry in the row
Sheets("doublons").Select
LastEntry = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Address
'Define the range to examine
Sheets("base").Select
Set Cell_Range = ActiveSheet.Range("b5", LastEntry)
For Each Cell In Cell_Range
On Error Resume Next
MyCollection.Add Item:="1", Key:=Cell.Text
If Err.Number = 457 Then
Cell.Interior.ColorIndex = 6
Cell.Offset(, 13).Value = "01.01.2005"
Err.Clear
End If
Next Cell
End Sub

 

[mefis]

Re : doublons et modif cellule+2

aidez moi svp
je tourne en rond depuis une semaine
merci a tous