Suppression d'une ligne sur conditions
Bonjour à tous,
Bonjour le forum.
Dans le cadre d'une analyse de données, je voudrais supprimer certaines lignes suivants différentes options.
Le tableau représente des références multi sources pour une liste d'articles.
La colonne B représente le code article
La colonne G représente la référence fournisseur
La colonne I le nom du fournisseur
La colonne J est une référence unique faite par concaténation
et enfin la colonne K le statut de la référence:
"" référence valide
/ référence valide
; référence obsolète
? référence sur accord B.E.
Les données sont issues de notre ERP en automatique
L'ERP exporte 4 sources au maximum (pour le moment) de chaque article d'une nomenclature.
L'ERP exporte normalement 4 sources valides s'il y en a 4.
S'il n'y a pas 4 sources valides, il va extraire des sources obsolètes ou sur accord BE
Je voudrais ne garder que les sources valides ("" ou "/") par référence article mais s'il n'y avait aucune source valide ("" ou "/"), alors je garderai toutes les sources (";" et "?") de cet article.
L'onglet 1 représente la source de départ
L'onglet 2 représente la sélection (en jaune les lignes à supprimer car il existe une source valide, en orange des lignes qui devraient être normalement supprimées mais comme il n'existe pas de source valide pour cet article les lignes seront gardées)
L'onglet 3 représente le résultat que je souhaite obtenir.
La suppression des lignes devra se faire dans l'onglet source par une macro en vba que je lance à partir d'un autre fichier (j'adapterai).
Pour info, à l'heure actuelle, je filtre sur le statut, je colorie en couleur les lignes non valide, j'enlève le filtre, je regarde si une source valide, je supprime a la main les ligne que je ne veux pas.
Mes tableaux font en moyenne 2000 à 3000 lignes et je traite plusieurs tableaux comme cela par jours...
Je vous remercie par avance
Zyglur
Bonjour,
Pour les besoins, j'ai créé deux onglets nommés : Tcd et 1-Source (2)
Sub MiseEnFormeTableauSource()
Dim ShTcd As Worksheet, ShSource2 As Worksheet
Dim DerniereLigne As Long, DerniereColonne As Long
Dim ColSlash As Long, ColPointVirgule As Long, ColInterrogation As Long, ColVide As Long
Dim I As Integer, IndexMatrice As Integer
Dim AireSource As Range, AireReferences As Range, AireSourceRef As Range, AireSourceStatut As Range
Dim Pvt As PivotTable
Dim MatriceRef() As Variant
Dim HeureDebut2, HeureFin2, TempsTotal2
HeureDebut2 = Timer ' Définit l'heure de début.
Set ShTcd = Sheets("Tcd")
ShTcd.Cells.Clear
Set ShSource2 = Sheets("1-Source (2)")
ShSource2.Cells.Clear
Sheets("1-Source").Range("A1").CurrentRegion.Copy Destination:=ShSource2.Range("A1")
Set AireSource = ShSource2.Range("A1").CurrentRegion
ShSource2.ListObjects.Add(xlSrcRange, AireSource, , xlYes).Name = "t_Source2"
Set AireSourceRef = Range("t_Source2[Ref.Interne]")
Set AireSourceStatut = Range("t_Source2[Status]")
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=AireSource).CreatePivotTable TableDestination:="Tcd!R3C1", TableName:="TCD1"
ShTcd.Activate
Set Pvt = ShTcd.PivotTables("TCD1")
With Pvt.PivotFields("Status")
.Orientation = xlColumnField
.Position = 1
End With
Pvt.AddDataField Pvt.PivotFields("Ref.Interne"), "Nombre de Ref.Interne", xlCount
With Pvt.PivotFields("Ref.Interne")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("TCD1")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
' Copie du TCD sur lui-même pour ne conserver que les valeurs.
Pvt.TableRange2.Copy
With ShTcd
.Range("A3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
DerniereColonne = .Cells(5, .Columns.Count).End(xlToLeft).Column
' Identification des colonnes du TCD
For I = 2 To DerniereColonne
Select Case .Cells(4, I)
Case "/"
ColSlash = I
Case ";"
ColPointVirgule = I
Case "?"
ColInterrogation = I
Case "(vide)"
ColVide = I
End Select
Next I
Set AireReferences = .Range(.Cells(5, 1), .Cells(DerniereLigne, 1))
IndexMatrice = 0
' Recherche des enregistrements ; et ? à garder, et enregistrement dans une matrice
For I = 1 To AireReferences.Count
With AireReferences(I)
If .Offset(0, ColPointVirgule - 1) > 0 And .Offset(0, ColSlash - 1) = 0 And .Offset(0, ColVide - 1) = 0 Then
ReDim Preserve MatriceRef(1, IndexMatrice)
MatriceRef(0, IndexMatrice) = .Value
MatriceRef(1, IndexMatrice) = ";"
IndexMatrice = IndexMatrice + 1
End If
If .Offset(0, ColInterrogation - 1) > 0 And .Offset(0, ColSlash - 1) = 0 And .Offset(0, ColVide - 1) = 0 Then
ReDim Preserve MatriceRef(1, IndexMatrice)
MatriceRef(0, IndexMatrice) = .Value
MatriceRef(1, IndexMatrice) = "?"
IndexMatrice = IndexMatrice + 1
End If
End With
Next I
If IndexMatrice > 0 Then
' Recherche des enregistrements à garder dans le tableau source
For IndexMatrice = LBound(MatriceRef, 2) To UBound(MatriceRef, 2)
For I = 1 To AireSourceRef.Count
If MatriceRef(0, IndexMatrice) = AireSourceRef(I) And MatriceRef(1, IndexMatrice) = AireSourceStatut(I) Then
AireSourceStatut(I) = AireSourceStatut(I) & " A garder"
End If
Next I
Next IndexMatrice
' Effacement des enregistrements ; et ? qui ne sont pas à garder
For I = 1 To AireSourceRef.Count
If AireSourceStatut(I) = ";" Or AireSourceStatut(I) = "?" Then
AireSourceStatut(I).EntireRow.Clear
End If
Next I
' Tri du tableau source
With ShSource2.ListObjects("t_Source2")
.Sort.SortFields.Clear
.Sort.SortFields.Add2 Key:=Range("t_Source2[Ref.Interne]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End If
End With
ShSource2.Activate
HeureFin2 = Timer
TempsTotal2 = HeureFin2 - HeureDebut2
MsgBox "Temps total du traitement : " & Round(TempsTotal2, 1) & " seconde(s)"
Set ShTcd = Nothing: Set ShSource2 = Nothing
Set AireSource = Nothing
Set Pvt = Nothing
End SubBonjour à tous,
Merci à tous. Le résultat est là.
Eric Kergresse,
La macro fonctionne, mais il faut créer plusieurs autres feuilles. Mais le fait de passer par un TDC qui fait un état des status par référence est intéressante.
Rag02700,
Je ne connais pas Power Query et j'ai eu du mal à comprendre comment lancer la fonction. Il faut qu'il y ai une feuille de paramétrée en amont, ce qui n'est pas mon cas. Mais je vais me pencher sur le sujet car ca a l'air puissant.
gmb,
La fonction est simple, le format des colonnes est gardé et la macro facilement transposable dans mon fichier.
Un grand merci à vous tous.
Passez un excellent week-end.
Zyglur38
re,
une autre possibilité avec une macro simple
Sub Zyglur()
Dim iRows
With Sheets("1-Source")
Set c = .Range("A1").CurrentRegion
iRows = c.Rows.Count
With c.Offset(, 26).Resize(, 1)
.Formula2R1C1 = "=--OR(RC11=""/"",RC11="""",SUMPRODUCT((R2C2:R" & iRows & "C2=RC2)*((R2C11:R" & iRows & "C11=""/"")+(R2C11:R" & iRows & "C11="""")))=0)"
.AutoFilter 1, 1
End With
End With
With Sheets("3-résultat souhaité")
.Range("A1:N1").EntireColumn.ClearContents
c.Copy
.Range("A1").PasteSpecial xlAll
End With
End SubBonjour Bsalv,
Désolé, mais le résultat n'est pas correct.
Merci quand même.
Cordialement
Zyglur38