Microsoft 365 Excel VBA

mo_owen · 21 Septembre 2022

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

chris · 25 Septembre 2022

RE

J'ai décomposé en plusieurs requête pour que tu comprennes la logique et puisse devenir autonome

sylvanu · 21 Septembre 2022

Bonjour Mo_owen, et bienvenu sur XLD,
Sur mon PC, vos PJ ne s'ouvrent pas :

Essayez de relivrer. Quelle différence entre les deux fichiers ?

M12 · 21 Septembre 2022

Bonjour,
un test

chris · 21 Septembre 2022

Bonjour à tous

Une solution sans VBA par PowerQuery intégré à Excel

vgendron · 21 Septembre 2022

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

mo_owen · 21 Septembre 2022

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 ?

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)

mo_owen · 21 Septembre 2022

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)

pas de différence juste l'extension sui change, tu choisira ce qui te conviens.

Merci

sylvanu · 21 Septembre 2022

Re,
Vous avez trois solutions ci dessus.
Vous conviennent elles ?
Sinon, dites nous pourquoi.

mo_owen · 21 Septembre 2022

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

Merci pour la réponse, cependant j'ai un problème lors de l'éxécution du code

mo_owen · 21 Septembre 2022

chris à dit:
Bonjour à tous

Une solution sans VBA par PowerQuery intégré à Excel

Merci pour ta réponse, ta solution est sous power BI ?

mo_owen · 21 Septembre 2022

M12 à dit:
Bonjour,
un test

Bonjour merci pour ta réponse, cependant je n'arrive pas à éxécuter la macro, possible de me montrer le code merci

vgendron · 21 Septembre 2022

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

vgendron · 21 Septembre 2022

mo_owen à dit:
Bonjour merci pour ta réponse, cependant je n'arrive pas à éxécuter la macro, possible de me montrer le code merci

La macro est dans le fichier...

mo_owen · 21 Septembre 2022

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

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

vgendron · 21 Septembre 2022

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

et bah... c'est pas déjà le cas??
si tes données sont triées par Code puis par date...

Microsoft 365 Excel VBA

mo_owen

XLDnaute Nouveau

Pièces jointes

chris

sylvanu

XLDnaute Barbatruc

M12

XLDnaute Accro

Pièces jointes

chris

XLDnaute Barbatruc

Pièces jointes

vgendron

XLDnaute Barbatruc

mo_owen

XLDnaute Nouveau

Pièces jointes

mo_owen

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

mo_owen

XLDnaute Nouveau

mo_owen

XLDnaute Nouveau

mo_owen

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

mo_owen

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

Discussions similaires