Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Supprimer la pièce et sont annulation en VBA

iliess

XLDnaute Occasionnel
Bonjour
je suis un comptable et parfois j'ai fais des annulation des pièces comptable
mon objectif de supprimer la pièce original et la pièce annuler.
je vous explique
mon grand livre se compose de 8 colonne et 400000 ligne ou plus (un ficher volumineux) la colonne F c'est le libelle
si une pièce est annuler ou contre passe ce caractère "-C_" figure dans le libelle de la pièce contre passe mené avec le numéro de la pièce original.
un exemple

pièce original
journal N°PIECE LIBELLE
ACH 0000005 12547-achat matériel de construction Fac 12/2021
pièce contre passe ou annuler
ACH 0000045 12547-C_0000005 achat matériel de construction Fac 12/2021

donc la pièce ACH 0000045 est l'annulation de la pièce ACH 0000005

Svp comment supprimer les deux pièce
au début j'ai utiliser cette fonction =SI(SIERREUR(CHERCHE("*-C_*";F3);"")=1;C3&STXT(F3;CHERCHE("-C_";F3)+3;7);C3&D3).
mais je n'est pas pu travailler en vba
 

Pièces jointes

  • Piece et sont anulation.xlsx
    12 KB · Affichages: 7

Wayki

XLDnaute Impliqué
Bonjour,
Une proposition ci-joint.
Je n'ai pas réussi à supprimer les 2 sans filtrer au préalable les données. A essayer.
VB:
Sub test1()
Dim f As Long, cellule As Range, Rech As String, num As Byte
f = Range("F" & Rows.Count).End(xlUp).Row
Rech = Range("F1:F" & f).Find("-C_")
Cde = Left(Rech, 5)
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add2 Key:=Range("A3:A" & f) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("A3:K" & f)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Dim Tablo()
ReDim Tablo(0)
num = 0
For i = 2 To f
    
    If Left(Range("F" & i), 5) = Cde Then
    Tablo(num) = i
    num = num + 1
    ReDim Preserve Tablo(num)
    End If
    
Next i

For i = LBound(Tablo) To UBound(Tablo) - 1

Range(Rows(Tablo(0)), Rows(Tablo(i))).Select

    
Next i
Selection.Delete
End Sub
A +
 

Jacky67

XLDnaute Barbatruc
Bonjour à tous,
Une proposition par vba avec ce code
VB:
Sub Supprimer()
    Dim Plage, tmp$
    Application.ScreenUpdating = False
    With Feuil1
        If .FilterMode Then .ShowAllData
        Set Plage = .Range("a2:i" & .Cells(.Rows.Count, "a").End(xlUp).Row)
        Plage.AutoFilter Field:=6, Criteria1:="=*-C*"
        On Error Resume Next    'rien a filtrer
        tmp = Left(.Cells(.Range("_FilterDataBase").Offset(1, 0).Resize(.Range("_FilterDataBase").Rows.Count - 1).SpecialCells(xlCellTypeVisible).Row, 6), Application.Find("-C", .Cells(.Range("_FilterDataBase").Offset(1, 0).Resize(.Range("_FilterDataBase").Rows.Count - 1).SpecialCells(xlCellTypeVisible).Row, 6)) - 1)
        If tmp <> "" Then
            Plage.AutoFilter Field:=6, Criteria1:="=" & tmp & "*"
            Plage.Offset(1).Resize(Plage.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End If
        Plage.AutoFilter
    End With
End Sub
 

Pièces jointes

  • Piece et sont anulation.xlsm
    20.7 KB · Affichages: 6
Dernière édition:

iliess

XLDnaute Occasionnel
Bonjour Mr @Wayki
merci pour votre code
mais lorsque j'appliquer le code dans mon grand livre sa marche pas a 100% car le le numéro du pièce original se trouve après le -C_
c'est a dire Cde = right(Rech, 7)
je vais essayé de modifier votre code et vous présente ce que je pourrai le faire.
 

iliess

XLDnaute Occasionnel
bonsoir Mr @Jacky67
merci pour votre réponse
votre code ne supprime pas tous les pièce Contre passe dans mon grand livre car le filtre doit être sur cette expression "-C_"
 

iliess

XLDnaute Occasionnel
Chers amis il faut concaténé le numéro de pièce et le journal comme une clé pour identifier la pièce original et sa contre passe
c'est a dire
ACH 0000045 perte sur valeur la clé est ACH0000045
ACH 0000587 -C_0000045 perte sur valeur la clé est ACH0000045

les deux clé sont identique maintenait je supprime les deux.
 

iliess

XLDnaute Occasionnel
Re
voila les amis le code il est lent vu le nombre de ligne mais il est très efficace

VB:
Sub test1()
Dim Arr
Dim Dern As Long, Clé1 As String, Clé2 As String
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Feuil1")
Dern = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row


For i = 2 To Dern
    
    If Range("F" & i).Value Like "*-C_*" Then
     Clé1 = Evaluate("C" & i & " & mid(F" & i & ",search(""-C_"",F" & i & ")+3,7)")
            
            For j = 2 To Dern
             Clé2 = Range("C" & j).Value & Range("D" & j).Value
                    
                    If Clé1 = Clé2 Then
                        Range("I" & i).Value = "Oui"
                        Range("I" & j).Value = "Oui"
                    
                    End If
            
            Next j
        
    End If

Next i
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…