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: 1
  • 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

D
  • Résolu(e)
Microsoft 365 TRIER SUR FEUILLE PROTEGER
Réponses
8
Affichages
138
dd_76
D
C
  • Question
Microsoft 365 Modifier un tableau pour reporting
Réponses
5
Affichages
160
alexga78
A
chris6999
  • Question
Microsoft 365 Conserver la valeur de ma variable pour l'utiliser dans un autre code
Réponses
3
Affichages
100
mapomme
mapomme
P
  • 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
203
phil75016
P
M
  • Question
Microsoft 365 code vba : trier selon un ou plusieurs criteres
Réponses
2
Affichages
286
mo_owen
M
J
  • Résolu(e)
XL 2021 plantage lors d'un export format PDF
Réponses
14
Affichages
220
JPaul78
J
L
  • Question
XL 2016 Création d'une étiquette CB avec Excel
Réponses
5
Affichages
195
lincoln75
L
C
  • Question
Microsoft 365 Extraction de datas dans des fichiers pdf
Réponses
2
Affichages
213
kiki29
kiki29
C
  • Question
Microsoft 365 Ouverture Dossiers par VBA
Réponses
9
Affichages
272
Chev
C
D
  • Question
Microsoft 365 Couper Coller Fichiers en VBA
Réponses
3
Affichages
273
patricktoulon
patricktoulon

Membres actuellement en ligne

12 membres et 176 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
312 088
Messages
2 085 202
Membres
102 817
dernier inscrit
Nini668