Créer une boucle pour analyser une plage de données
Bonjour à tous,
je suis en train de sécher sur une macro VBA que je souhaite créer .
(en PJ le fichier en question)
Concrètement :
je souhaiterais supprimer les lignes dont : ( et conserver les autres)
Conditions : Un meme client a acheté le meme jour Brebis ET Chèvres au moins une fois.
Si ces conditions sont reunies : supprimer TOUTES les lignes du client en question.
Je vous remercie infiniment pour votre aide, et reste a votre disposition pour toute clarification.
KMP33
bonjour
une proposition
Sub aargh()
With Sheets("sheet1")
dl = .Cells(.Rows.Count, 1).End(xlUp).Row
cl = ""
For i = dl To 1 Step -1
If cl <> .Cells(i, 1) Then
If b And c Then .Rows(lr & ":" & fr).Delete shift:=xlUp
b = False
c = False
fr = i
cl = .Cells(i, 1)
End If
lr = i
If .Cells(i, 2) = "Chevres" Then
c = True
ElseIf .Cells(i, 2) = "Brebis" Then
b = True
End If
Next i
End With
End SubBonjour et merci infiniment ! cela fonctionne parfaitement
Bonne journée
Bonjour,
en fait cela ne fonctionne pas completement.
en faisant le test, le probleme est que cela ne prend pas en compte les dates.
en effet: il faudrait que cela supprime toutes les lignes du meme client si et seulement si le meme jour, il a acheté ET des chèvres ET des brebis.
Merci beaucoup pour votre aide
bonjour,
un adaptation du code
Sub aargh()
With Sheets("sheet1")
dl = .Cells(.Rows.Count, 1).End(xlUp).Row
cl = ""
cd = ""
For i = dl To 1 Step -1
If cl <> .Cells(i, 1) Then
If b And c Then .Rows(lr & ":" & fr).Delete shift:=xlUp
b = False
c = False
fr = i
cl = .Cells(i, 1)
End If
lr = i
If cd <> .Cells(i, 3) Then
If Not (b And c) Then
c = False
b = False
End If
cd = .Cells(i, 3)
End If
If .Cells(i, 2) = "Chevres" Then
c = True
ElseIf .Cells(i, 2) = "Brebis" Then
b = True
End If
Next i
End With
End SubCa fonctionne sur mon exemple. merci... mais je n'arrive meme pas a l'adapter sur mon fichier... pouvez vous maider svp? après cela sera bon
voici le format reel en PJ
merci encore.
il y a que 2 colonnes inversées en realite.. merci pour votre aide.. je seche
re-bonjour,
voici le code adapté
Sub aargh()
With Sheets("sheet1")
dl = .Cells(.Rows.Count, 1).End(xlUp).Row
cl = ""
cd = ""
For i = dl To 1 Step -1
If cl <> .Cells(i, 3) Then
If b And c Then .Rows(lr & ":" & fr).Delete shift:=xlUp
b = False
c = False
fr = i
cl = .Cells(i, 3)
End If
lr = i
If cd <> .Cells(i, 4) Then
If Not (b And c) Then
c = False
b = False
End If
cd = .Cells(i, 4)
End If
If .Cells(i, 2) = "Chevres" Then
c = True
ElseIf .Cells(i, 2) = "Brebis" Then
b = True
End If
Next i
End With
End SubMerci beaucoup,
petite question : j'ai dans la colonne 2 (clients), des clients en chiffres et/ou en lettres.
Cela prendrait en compte un client comme : "24546" ? ou avec des caracteres speciaux genre "_"?
merci encore.
KMP33
bonjour,
oui, as-tu testé ?
j'ai oublié de préciser que le tableau doit être trié sur client et sur date pour que la macro fonctionne correctement, sinon il faut que je l'adapte.
Oui j ai essaye mais effectivement ca ne fonctionne pas en totalite .
j ai deja une macro presente sur ce fichier et j ai peur de ne pas pouvoir trier dates et client par peur de ne plus faire fonctionner la premiere..
Merci beaucoup
En tout cas.. deja cela fonctionne en triant client et dates.. ce qui est top!! merci
re-bonjour,
j'ai adapté la macro
elle mémorise la position initiale des lignes
elle trie le tableau
execute les suppressions de lignes
restaure le tableau sans les lignes supprimées dans l'ordre initial
Sub aargh()
With Sheets("sheet1")
dl = .Cells(.Rows.Count, 1).End(xlUp).Row
.Columns(5).Insert shift:=xlToRight
For i = 1 To dl
.Cells(i, 5) = i
Next i
.Range("A1:E" & dl).Sort key1:=.Range("C1"), order1:=xlAscending, key2:=.Range("D1"), order2:=xlAscending, Header:=xlYes
cl = ""
cd = ""
For i = dl To 1 Step -1
If cl <> .Cells(i, 3) Then
If b And c Then .Rows(lr & ":" & fr).Delete shift:=xlUp
b = False
c = False
fr = i
cl = .Cells(i, 3)
End If
lr = i
If cd <> .Cells(i, 4) Then
If Not (b And c) Then
c = False
b = False
End If
cd = .Cells(i, 4)
End If
If .Cells(i, 2) = "Chevres" Then
c = True
ElseIf .Cells(i, 2) = "Brebis" Then
b = True
End If
Next i
dl = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A1:E" & dl).Sort key1:=.Range("E1"), order1:=xlAscending, Header:=xlYes
.Columns(5).Delete shift:=xlToLeft
End With
End SubMagnifique !! merci encore !! bonne journee
Hello! desole mais j'aurais un petit update...
Finalement après plusieurs essais non concluants (erreur de ma part) je m'aperçois qu il faut revoir la macro.. Pas au niveau des conditions mais au niveau du "qu est ce qu il se passe" lorsque les conditions sont reunies :
Si et seulement si, un meme client achete ET une brebis ET une chevre à la meme date ==> supprimer tous les achats de la journee concernée sur ce client uniquement.
Merci beaucoup d avance!!
KMP 33
bonjour,
code adapté
Sub aargh()
With Sheets("sheet1")
dl = .Cells(.Rows.Count, 1).End(xlUp).Row
.Columns(5).Insert shift:=xlToRight
For i = 1 To dl
.Cells(i, 5) = i
Next i
.Range("A1:E" & dl).Sort key1:=.Range("C1"), order1:=xlAscending, key2:=.Range("D1"), order2:=xlAscending, Header:=xlYes
cl = ""
cd = ""
For i = dl To 1 Step -1
If cl <> .Cells(i, 3) Or cd <> .Cells(i, 4) Then
If b And c Then .Rows(lr & ":" & fr).Delete shift:=xlUp
b = False
c = False
fr = i
cl = .Cells(i, 3)
cd = .Cells(i, 4)
End If
lr = i
If .Cells(i, 2) = "Chevres" Then
c = True
ElseIf .Cells(i, 2) = "Brebis" Then
b = True
End If
Next i
dl = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A1:E" & dl).Sort key1:=.Range("E1"), order1:=xlAscending, Header:=xlYes
.Columns(5).Delete shift:=xlToLeft
End With
End SubBonjour, et merci pour votre réponse.
je souhaiterais cependant adapter le code avec une nouvelle condition.. que je n'arrive pas à faire!!
Pourriez-vous svp m'aider sur cette demande?
Si un meme client, achète 2 brebis le meme jour de meme type, il faut conserver la ligne dont la date de validite est la plus lointaine et supprimer l'autre.
je reste a votre disposition pour toute clarification.
merci encore pour votre aide
KMP33
Bonjour,
J'ai reessayé a nouveau en attendant votre réponse mais je n'y arrive malheuresement toujours pas !
merci,
cordialement,
KMP33
Bonjour Kmp,
Bonjour le forum,
peux-tu me faire un récapitulatif de ce que tu attends ?
je vois une nouvelle demande. Comment doit-elle s'intégrer dans les demandes précédentes ?
ps j'ai un doute sur la sincérité de ton merci, il arrive 3 semaines plus tard et est lié à une nouvelle demande. Est-ce que je l'attendrais encore si tu n'avais pas de nouvelle demande ?
Bonjour et merci pour ta réponse, effectivement je ne t’ai pas remercié sur la dernière demande. Ce qui est un manque de respect et je m’en Excuse sincèrement.
En ce qui concerne la nouvelle demande : c’est indépendant de la dernière réponse que tu avais apportée. Cela concerne un nouveau fichier pour une nouvelle macro.
Merci d’avance.
kmp33
re-Bonjour,
bonjour le forum,
voici une proposition
Sub aargh()
With Sheets("sheet1")
dl = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To dl
.Cells(i, "H") = i
.Cells(i, "I") = .Cells(i, 3) & .Cells(i, 2) & .Cells(i, 4) & .Cells(i, 7)
Next i
.Range("A1:I" & dl).Sort key1:=.Range("I1"), order1:=xlAscending, Header:=xlYes
For i = dl To 2 Step -1
If .Cells(i, "I") = .Cells(i - 1, "i") Then .Rows(i).Delete shift:=xlUp
Next i
.Range("A1:I" & dl).Sort key1:=.Range("H1"), order1:=xlAscending, Header:=xlYes
.Columns("H:I").Delete shift:=xlToLeft
End With
End Sub