Microsoft 365 Excel VBA

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
M

mo_owen

XLDnaute Nouveau
Bonjour à tous je suis novice en VBA et j'ai besoin de votre aide

Voici le fichier Excel ci joint

Il comporte trois feuilles excel. (ORIGINAL, RESULTAT ATTENDU, COPY_ORIGINAL_POUR_TEST).

Je voudrais si possible un code qui se rapproche de la suppression des doublons mais pas que. J'ai besoin d'un code qui garde le plus ancien et le plus récent dossier pour un numéro de dossier donné.

Cependant, Dans le fichier j'ai des doublons, un dossier unique, des triplons, quatriplons etc.....


Résultat attendu:
Besoin de 2 lignes (le plus ancien et la plus récent pour chaque numéro de dossier dossier en prenant en compte le code journal A) pour chaque dossier à savoir le premier dossier (le plus ancien dossier) et le dernier dossier (le plus récent) du même numéro de dossier.)

je récapitule : Si le code journal == A alors récupère le dossier le plus ancien et le plus récent; mais pour chaque numéro de dossier

Cordialement
Merci pour votre aide
 

Pièces jointes

Dernière édition:
Trier par date Trier par votes
Hello
un test ici
VB: 
Sub test2()
Dim TabData() As Variant
With Sheets("Original")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    TabData = .Range("A1:D" & fin).Value
End With

Range("D2") = "P"

For i = 2 To fin
    If Range("A" & i) = Range("A" & i - 1) Then
        If Range("A" & i + 1) = Range("A" & i) Then
            Range("D" & i + 1) = "D"
            Range("D" & i) = ""
        Else
            Range("D" & i) = "D"
        End If
    Else
        
        Range("D" & i) = "P"
    End If
Next i

Sw = "D"
For i = fin To 2 Step -1
    If Range("D" & i) = Sw Then
        Sw = IIf(Sw = "D", "P", "D")
    Else
        Rows(i).Delete
    End If
    
Next i
End Sub
 
Vote positif 0 Vote négatif
sylvanu à dit:
Bonjour Mo_owen, et bienvenu sur XLD,
Sur mon PC, vos PJ ne s'ouvrent pas :
Regarde la pièce jointe 1150176
Essayez de relivrer. Quelle différence entre les deux fichiers ?
Cliquez pour agrandir...
Désolé je viens de voir ton message
Cependant j'ai oublié une information importante dans ma demande.

je souhaiterai avoir pour chaque numéro de dossier, le dossier le plus ancien et le dossier le plus récent en tenant compte de la colonne Code journal (je veux tous les dossier (le plus ancien et le plus récent pour chaque numéro de dossier) qui ont le code journal A)
 

Pièces jointes

Vote positif 0 Vote négatif
mo_owen à dit:
Désolé je viens de voir ton message
Cependant j'ai oublié une information importante dans ma demande.

je souhaiterai avoir pour chaque numéro de dossier, le dossier le plus ancien et le dossier le plus récent en tenant compte de la colonne Code journal (je veux tous les dossier (le plus ancien et le plus récent pour chaque numéro de dossier) qui ont le code journal A)
Cliquez pour agrandir...
pas de différence juste l'extension sui change, tu choisira ce qui te conviens.

Merci
 
Vote positif 0 Vote négatif
vgendron à dit:
Hello
un test ici
VB: 
Sub test2()
Dim TabData() As Variant
With Sheets("Original")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    TabData = .Range("A1:D" & fin).Value
End With

Range("D2") = "P"

For i = 2 To fin
    If Range("A" & i) = Range("A" & i - 1) Then
        If Range("A" & i + 1) = Range("A" & i) Then
            Range("D" & i + 1) = "D"
            Range("D" & i) = ""
        Else
            Range("D" & i) = "D"
        End If
    Else
       
        Range("D" & i) = "P"
    End If
Next i

Sw = "D"
For i = fin To 2 Step -1
    If Range("D" & i) = Sw Then
        Sw = IIf(Sw = "D", "P", "D")
    Else
        Rows(i).Delete
    End If
   
Next i
End Sub
Cliquez pour agrandir...
Merci pour la réponse, cependant j'ai un problème lors de l'éxécution du code
1663757595125.png
 
Vote positif 0 Vote négatif
Cette version travaille avec un tableau vba
VB: 
Sub test()
Dim TabData() As Variant
With Sheets("Original")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    TabData = .Range("A1:D" & fin).Value
End With

TabData(2, 4) = "P"
For i = LBound(TabData, 1) + 1 To UBound(TabData, 1) - 1
    If TabData(i, 1) = TabData(i - 1, 1) Then
        If TabData(i + 1, 1) = TabData(i, 1) Then
            TabData(i + 1, 4) = "D"
            TabData(i, 4) = ""
        Else
            TabData(i, 4) = "D"
        
        End If
    Else
        
        TabData(i, 4) = "P"
    End If
Next i

SW = "D"
For i = UBound(TabData, 1) To LBound(TabData, 1) + 1 Step -1
    If TabData(i, 4) = SW Then
        SW = IIf(SW = "D", "P", "D")
    Else
        For j = LBound(TabData, 2) To UBound(TabData, 2)
            TabData(i, j) = ""
        Next j
    End If
Next i

With Sheets("RESULTAT ATTENDU")
    .Range("A1").Resize(UBound(TabData, 1), UBound(TabData, 2)) = TabData
    .Range("A1").Resize(UBound(TabData, 1), UBound(TabData, 2)).Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
 
Vote positif 0 Vote négatif
vgendron à dit:
Hello
un test ici
VB: 
Sub test2()
Dim TabData() As Variant
With Sheets("Original")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    TabData = .Range("A1:D" & fin).Value
End With

Range("D2") = "P"

For i = 2 To fin
    If Range("A" & i) = Range("A" & i - 1) Then
        If Range("A" & i + 1) = Range("A" & i) Then
            Range("D" & i + 1) = "D"
            Range("D" & i) = ""
        Else
            Range("D" & i) = "D"
        End If
    Else
       
        Range("D" & i) = "P"
    End If
Next i

Sw = "D"
For i = fin To 2 Step -1
    If Range("D" & i) = Sw Then
        Sw = IIf(Sw = "D", "P", "D")
    Else
        Rows(i).Delete
    End If
   
Next i
End Sub
Cliquez pour agrandir...
Bonjour Chef, ton code marche hyper bien cepandant, je oublier un dernier détail, il faut tenir compte de la date du dossier. je veux récupere pour chaque numéro de dossier, le dossier le plus ancien et le dossier le plus récent au regarde de la colonne date. Merci de me répondre
 
Vote positif 0 Vote négatif
mo_owen à dit:
Bonjour Chef, ton code marche hyper bien cepandant, je oublier un dernier détail, il faut tenir compte de la date du dossier. je veux récupere pour chaque numéro de dossier, le dossier le plus ancien et le dossier le plus récent au regarde de la colonne date. Merci de me répondre
Cliquez pour agrandir...

et bah... c'est pas déjà le cas??
si tes données sont triées par Code puis par date...
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

T
  • Résolu(e)
XL 2019 Filtrer certains champs au démarrage avec vba
2
Réponses
15
Affichages
180
telemarrk
T
J
  • Question Question
Microsoft 365 Copie des onglets dans un fichier séparé depuis une liste en VBA
Réponses
3
Affichages
42
job75
job75
C
  • Question Question
XL 2021 Mail automatique avec date butoire dans excel
Réponses
4
Affichages
65
sylvanu
sylvanu
M
  • Question Question
XL 2013 MACRO VBA pour imprimer tous les bulletins d'un établissement scolaire
Réponses
4
Affichages
307
MBEPID
M
M
  • Question Question
XL 2019 Transposer des données d'une feuille vers une autre sous forme de synthèse
Réponses
8
Affichages
318
mromain
mromain
H
  • Question Question
XL 2021 **RESOLU** Formule "ok" et "pas ok"
Réponses
2
Affichages
63
hades
H
V
  • Question Question
Microsoft 365 VBA deux document Excel
Réponses
10
Affichages
519
vroumvroum
V
J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
129
JJ69
J
D
  • Résolu(e)
XL 2019 Nouveau numero
Réponses
8
Affichages
77
Danyk01
D
F
  • Question Question
Microsoft 365 Problème avec VBA ( Résolu)
Réponses
2
Affichages
340
firecarl
F
D
  • Résolu(e)
XL 2019 Nouveau Numéro
2 3 4
Réponses
57
Affichages
2 K
patricktoulon
patricktoulon
M
  • Question Question
XL 2021 Creation VBA copie de differents fichiers dans différents dossiers
Réponses
5
Affichages
446
patricktoulon
patricktoulon
D
  • Résolu(e)
Microsoft 365 TRIER SUR FEUILLE PROTEGER
Réponses
8
Affichages
497
dd_76
D
P
  • Question Question
XL 2019 Changer nom d'export en VBA
Réponses
3
Affichages
538
job75
job75
edgy63
  • Question Question
Microsoft 365 Remplir cellules à partir de plusieurs fichiers Excel d'un dossier
2
Réponses
17
Affichages
600
alexga78
A
M
  • Question Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
408
Gégé-45550
Gégé-45550
T
  • Question Question
XL 2016 Erreur d'exécution 1004 : Impossible de définir la propriété Hidden de la classe Range
Réponses
3
Affichages
361
Phil69970
Phil69970
C
  • Question Question
Microsoft 365 délai traitement dossier en état instruction et par rapport date du jour et date de réception
Réponses
1
Affichages
492
Phil69970
Phil69970
R
  • Question Question
Microsoft 365 VBA Excel PowerPoint
Réponses
5
Affichages
334
Rem6610
R
P
  • Question Question
Microsoft 365 VBA - Enregistrer un fichier en pdf dans un dossier dont on ne connait que les 4 premiers caractères
Réponses
2
Affichages
466
phil75016
P
Retour