Extraire données l'une liste
Bonjour à tous,
Je n'arrive pas à faire fonctionner un code d'extraction de données.
Je dispose d'une liste de données extraites de plusieurs documents (colonne AQ). Chaque article de cette liste concerne des lots.
exemple:
article 1 : Lot 2
article 1 : Lot 15
article 1 : Lot 6
article 2 : Lot 6
article 2 : Lot 16
article 2 : Lot 63
J'essaie de mettre au point un code qui, à partir de la colonne contenant lot x liste les données de la ligne entre les colonnes AN:AV afin de regrouper les articles de chaque lot x.
exemple :
Lot 2 : article 1
Total lot 2 :
Lot 6 : article 1
Lot 6 : article 2
Total lot 6 :
Lot ...
Les lots vont de 1 à 100
Pour ce faire, je repars de ce code (qui ne fonctionne pas):
Sub recupdetail_lot()
Range("AY7").Select
'dans feuil2 colone AQ:AQ
Set plage = ThisWorkbook.Sheets("Feuil2").Columns("AQ:AQ")
'cherche "*logistique*"
Set re = plage.Find("*Lot X*", lookat:=xlWhole, MatchCase:=False)
If Not re Is Nothing Then
Set fr = re
Do
'copier la ligne des colonnes AN:AV
ActiveWorkbook.Sheets("Feuil2").Columns("AN:AV").Row.Copy
ActiveWorkbook.Sheets("Feuil2").Columns("BA:BI").Row.Paste
Set re = plage.FindNext(re)
Loop Until re Is Nothing Or re = fr
Do
End If
Next lig
End SubMerci d'avance pour votre aide
Bonjour, je vous suggère...Ceci
Set re = plage.Find("Lot", lookat:=xlpart, MatchCase:=False) ActiveWorkbook.Sheets("Feuil2").Range(Cells(re.Row, 40), Cells(re.Row, 48)).CopyMerci mais cela ne fonctionne toujours pas :
J'ai essayer cela :
Sub test()
Range("AY7").Select
Dim a
Dim L
a = a + 1
L = "Logistique" & a
Set plage = ThisWorkbook.Sheets("Feuil2").Columns("AQ:AQ")
Set re = plage.Find(L, LookIn:=xlValues, lookat:=xlPart, MatchCase:=True)
If Not re Is Nothing Then
Set fr = re
Do
ThisWorkbook.Sheets("Feuil2").Range(Cells(re.Row, 40), Cells(re.Row, 48)) = ThisWorkbook.Sheets("Feuil2").Range(Cells(re.Row, 50), Cells(re.Row, 58))
Set re = plage.FindNext(re)
Loop Until re Is Nothing Or re = fr
a = 90
End If
End SubBonjour , j'ai autre chose à faire que d'éditer x fois un code parce que vous décidez de le changer. De plus "cela ne fonctionne pas" ne nous aide pas vraiment pour faire un diagnostic [a méditer].
Sur ce, bonne fin de journée.
Bonjour,
Je suis prêt à revenir sur le code précédent, ma démarche consistait simplement à essayer de vous apportées de l'aide, je ne pensais pas que les modifications apportés changeaient tout le code.
Bonsoir à tous,
Un essai, en m'appuyant sur l'exemple présenté plus haut
Option Explicit
Sub test()
Dim myAreas As Areas, myArea As Range
Application.ScreenUpdating = False
Columns(1).Insert
With Range("c2", Range("c" & Rows.Count).End(xlUp)).Offset(, -2)
.Formula = "=if(and(c1<>"""",c2<>"""",c1<>c2),if(a1=1,""a"",1),"""")"
End With
On Error Resume Next
With Columns(1)
With .SpecialCells(-4123)
.Value = .Value
End With
.SpecialCells(2, 2).EntireRow.Insert
.SpecialCells(2, 1).EntireRow.Insert
.Delete
End With
Set myAreas = Range("a1", Range("a" & Rows.Count).End(xlUp)).SpecialCells(2).Areas
On Error GoTo 0
If myAreas Is Nothing Then Exit Sub
For Each myArea In myAreas
With myArea
.Cells(myArea.Rows.Count + 1, 1).Resize(, 2).Value = _
Array("Total " & .Cells(1).Offset(, 1).Value, _
"=counta(" & .Offset(, 1).Address & ")")
End With
Next
Application.ScreenUpdating = True
End Subklin89
Re Nuage75,
Le code réajusté :
Tes données en Feuil1 sans ligne d'en têtes comme illustré dans ton 1er post.
Option Explicit
Sub test()
Dim myAreas As Areas, myArea As Range
Application.ScreenUpdating = False
With Sheets("Feuil1")
With .Cells(1).CurrentRegion
.Columns(1).Copy .Cells(1, 3)
.Columns(1).ClearContents
End With
With .Range("b2", .Range("b" & Rows.Count).End(xlUp)).Offset(, -1)
.Formula = "=if(and(b1<>"""",b2<>"""",b1<>b2),if(a1=1,""a"",1),"""")"
End With
On Error Resume Next
With .Columns(1)
With .SpecialCells(-4123)
.Value = .Value
End With
.SpecialCells(2, 2).EntireRow.Insert
.SpecialCells(2, 1).EntireRow.Insert
.Delete
End With
Set myAreas = .Range("a1", .Range("a" & Rows.Count).End(xlUp)).SpecialCells(2).Areas
On Error GoTo 0
If myAreas Is Nothing Then Exit Sub
For Each myArea In myAreas
With myArea
.Cells(myArea.Rows.Count + 1, 1).Resize(, 2).Value = _
Array("Total " & .Cells(1).Value, _
"=counta(" & .Offset(, 1).Address & ")")
End With
Next
Set myAreas = Nothing
End With
Application.ScreenUpdating = True
End Subklin89
Merci pour votre aide mais je n'arrive pas à faire fonctionner ce code
Bonjour,
Une nouvelle proposition TCD (sans VBA pour l'exemple), à laquelle j'ai ajouté la procédure de kine89 (procédure fonctionnelle).
A te relire.
Cdlt.
Bonjour Jean Eric,
Le tableau me plait beaucoup, ci joint le tableau dans lequel j'aimerais intégrer le code. La colonne verte est la base de données et la colonne rouge la façon dont je veut que la macro me présente les données. Ce fichier contiens les 10 premiers devis mais en réalité il y en as plus de 460. Les lots vont de 01 à 90
Re,
Tu vas peut-être commencer par un peu de lecture.
Tu dois apprendre à structurer tes données.
Cdlt.
Merci pour les conseils, le seul qui m’embête est le fait de devoir placer les données d'entrée et les données de sortie dans deux feuilles différentes.
Ci-joint mon fichier modifié suite à tes conseils
Bonjour,
pourquoi des différences entre ton énoncé au post#1 et ce tableau
pour ce que j'ai compris, un total de 2 manières sur les "IND"... dans 2 onglets
P.4
Bonsoir à tous,
Je m'appuie sur la 4 éme colonne pour déterminer les clés.
De ton côté, comment définis-tu ces doublons, cela m'a l'air bien compliqué
Les expressions réguliéres (RegExp) sont très utiles dans ce cas, mais je ne sais pas faire
A tester :
Option Explicit
Sub test()
Dim dico As Object, i As Long, e, n As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
With Sheets(1).Range("a1").CurrentRegion 'Feuil2
For i = 2 To .Rows.Count
If Not dico.exists(.Cells(i, 4).Value) Then
If i = 2 Then
Set dico(.Cells(i, 4).Value) = Union(.Rows(1), .Rows(i))
Else
Set dico(.Cells(i, 4).Value) = .Rows(i)
End If
Else
Set dico(.Cells(i, 4).Value) = _
Union(dico(.Cells(i, 4).Value), .Rows(i))
End If
Next
End With
'Restitution
With Sheets(2) 'Feuil3
.Cells.Clear
For Each e In dico
n = n + 1
dico(e).Copy
'.Cells(n, 1).PasteSpecial xlPasteColumnWidths
.Cells(n, 1).PasteSpecial xlPasteValues
With .Cells(n, 1).CurrentRegion
With .Offset(.Rows.Count).Resize(1, 9)
If n = 1 Then
.Columns("a:i").Value = _
Array("", "", "", "TOTAL " & e, "=sum(r" & n + 1 & "c:r[-1]c)", "", "", _
"=sum(r" & n + 1 & "c:r[-1]c)", "")
Else
.Columns("a:i").Value = _
Array("", "", "", "TOTAL " & e, "=sum(r" & n & "c:r[-1]c)", "", "", _
"=sum(r" & n & "c:r[-1]c)", "")
End If
End With
n = n + .Rows.Count + 1
End With
Next
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Subklin89
Bonjour,
Je ne cherche pas à trier le tout en fonction des ind, mais en fonction de la colonne D.
Un tableau dynamique croisé ne me laissera pas assez de liberté par la suite.
Il faut que le code parcoure la colonne D et m'extrait les lignes contenant Lot 01 puis de même avec Lot 02 puis...03...etc.
Il y a 90 Lots.
Il me faut donc une boucle dans une boucle, la première lui demandant d'extraire les lignes contenant Lot X et la deuxième définissant comme étant égal à X = X + 1
Re Nuage75,
Dans la colonne D de ta base de données, c'est le Saint Esprit qui détermine qu'une ligne (1 enregistrement)
appartient à tel ou tel lot
Je ne possède qu'Excel 2003 et j'ouvre ton fichier avec le convertisseur, peut-être me manque t-il certains éléments.
Ma macro fait exactement ce que tu demandes, sauf que je n'arrive pas à définir les clés du dictionnaire pour détecter tes différents lots.
Précédemment, je t'ai posé une question.
klin89
Jean-Eric a écrit :Bonjour,
Une proposition TCD en VBA.
Hello ... ton code n'est il pas exclusivement pour excel 2010/2013 et donc pas compris par 2007 ?
ici il se plante sur
.RepeatAllLabels xlRepeatLabels
Bonjour Patrick,
Cette ligne est propre à Excel 2010 +.
Il faut l'inhiber pour les versions antérieures.
Pour 2007 il faut procéder différemment pour un même résultat.
Si tu veux en savoir plus, fais moi signe.
Cdlt.
Bonjour à tous,
Tout D'abord je vous remercie pour l'attention et le temps que vous consacrez à mon post.
Klin 89 : colonne D, Les cellules de la base de donnée contenant lot 01 à lot 90 sont à distinguer aux autre cellules ne contenant pas de numéro de lot. Le code devra lister toutes les lignes faisant apparaître Lot 1 puis lot 2 ... Un fois tous les lots listés, une dernière rubrique lot Divers devra faire apparaître toutes les lignes ne contenant pas de numéro lot et qui n'ont don pas été extraites précédemment.
Jean-Eric: Ton TCD VBA est juste super, cela se rapproche énormément du but final, je l’analyse dans la journée..