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

L
  • Question
XL 2019 Créer des dossiers et sous dossiers avec VBA
2
Réponses
19
Affichages
226
patricktoulon
patricktoulon
M
  • Question
XL 2019 Transposer des données d'une feuille vers une autre sous forme de synthèse
Réponses
8
Affichages
262
mromain
mromain
M
  • Question
XL 2013 MACRO VBA pour imprimer tous les bulletins d'un établissement scolaire
Réponses
4
Affichages
219
MBEPID
M
V
  • Question
Microsoft 365 VBA deux document Excel
Réponses
10
Affichages
452
vroumvroum
V
M
  • Question
XL 2021 Creation VBA copie de differents fichiers dans différents dossiers
Réponses
5
Affichages
373
patricktoulon
patricktoulon
J
  • 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
59
JJ69
J
edgy63
  • Question
Microsoft 365 Remplir cellules à partir de plusieurs fichiers Excel d'un dossier
2
Réponses
17
Affichages
500
alexga78
A
D
  • Résolu(e)
XL 2019 Nouveau Numéro
2 3 4
Réponses
57
Affichages
1 K
patricktoulon
patricktoulon
D
  • Résolu(e)
Microsoft 365 TRIER SUR FEUILLE PROTEGER
Réponses
8
Affichages
459
dd_76
D
M
  • Question
Microsoft 365 Extraire une valeur sous 2 conditions
Réponses
10
Affichages
299
Milou86
M

Membres actuellement en ligne

12 membres et 140 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
315 093
Messages
2 116 133
Membres
112 667
dernier inscrit
foyoman