Microsoft 365 Excel VBA

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

  • TestFinal_Automatisation.xlsx
    12 KB · Affichages: 2
  • TestFinal_Automatisation.xls
    50.5 KB · Affichages: 0
Dernière édition:
Trier par date Trier par votes
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Mo_owen, et bienvenu sur XLD,
Sur mon PC, vos PJ ne s'ouvrent pas :
1663744653277.png

Essayez de relivrer. Quelle différence entre les deux fichiers ?
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
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
M

mo_owen

XLDnaute Nouveau
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

  • TestFinal_Automatisation.xlsx
    12 KB · Affichages: 1
  • TestFinal_Automatisation.xls
    50.5 KB · Affichages: 2
Vote positif 0 Vote négatif
M

mo_owen

XLDnaute Nouveau
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
M

mo_owen

XLDnaute Nouveau
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
vgendron

vgendron

XLDnaute Barbatruc
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
M

mo_owen

XLDnaute Nouveau
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
vgendron

vgendron

XLDnaute Barbatruc
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

Discussions similaires

V
  • Question
Microsoft 365 VBA deux document Excel
Réponses
10
Affichages
383
vroumvroum
V
M
  • Question
XL 2021 Creation VBA copie de differents fichiers dans différents dossiers
Réponses
5
Affichages
305
patricktoulon
patricktoulon
edgy63
  • Question
Microsoft 365 Remplir cellules à partir de plusieurs fichiers Excel d'un dossier
2
Réponses
17
Affichages
378
alexga78
A
D
  • Résolu(e)
Microsoft 365 TRIER SUR FEUILLE PROTEGER
Réponses
8
Affichages
410
dd_76
D
M
  • Question
Microsoft 365 Extraire une valeur sous 2 conditions
Réponses
10
Affichages
228
Milou86
M
T
  • Question
XL 2016 Erreur d'exécution 1004 : Impossible de définir la propriété Hidden de la classe Range
Réponses
3
Affichages
234
Phil69970
Phil69970
C
  • 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
373
Phil69970
Phil69970
F
  • Question
XL 2019 Excel ne peut pas accèder "...". Le document est peut être en lecture seule ou chiffré.
Réponses
1
Affichages
379
wDog66
wDog66
jeffe
  • Résolu(e)
Microsoft 365 requête Dossier
Réponses
6
Affichages
408
jeffe
jeffe
C
  • Question
Microsoft 365 Modifier un tableau pour reporting
Réponses
5
Affichages
294
alexga78
A

Membres actuellement en ligne

19 membres et 291 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 422
Messages
2 109 447
Membres
110 482
dernier inscrit
ilyxxxh