Rechercher plusieurs valeurs
Re berty42,
J'ai réajusté le code, voici 2 versions un poil différentes.
Je te joins le fichier sous Excel2003, on se base toujours sur la colonne 6 pour nommer les fichiers générés.
1ère version : la macro te laisse le choix du remplacement lors de la regénération des fichiers, l'autre version non.
Sub Creation_classeurs1()
Dim rng As Range, i As Long, e, wb As Workbook
Application.ScreenUpdating = False
Set rng = Sheets("Feuil1").Range("a4").CurrentRegion
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 2 To rng.Rows.Count
If Not .exists(rng.Cells(i, 6).Value) Then
Set .Item(rng.Cells(i, 6).Value) = _
Union(rng.Rows(1), rng.Rows(i))
Else
Set .Item(rng.Cells(i, 6).Value) = _
Union(.Item(rng.Cells(i, 6).Value), rng.Rows(i))
End If
Next
For Each e In .keys
Set wb = Workbooks.Add
.Item(e).Copy wb.Sheets(1).Cells(1)
On Error Resume Next
wb.SaveAs ThisWorkbook.Path & "\" & Replace(e, "/", "-") & ".xls"
wb.Close False: Set wb = Nothing
Err.Clear
Next
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub2ème version :
Sub Creation_classeurs2()
Dim rng As Range, i As Long, e, wb As Workbook
Application.ScreenUpdating = False
Set rng = Sheets("Feuil1").Range("a4").CurrentRegion
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 2 To rng.Rows.Count
If Not .exists(rng.Cells(i, 6).Value) Then
Set .Item(rng.Cells(i, 6).Value) = _
Union(rng.Rows(1), rng.Rows(i))
Else
Set .Item(rng.Cells(i, 6).Value) = _
Union(.Item(rng.Cells(i, 6).Value), rng.Rows(i))
End If
Next
Application.DisplayAlerts = False
For Each e In .keys
Set wb = Workbooks.Add
.Item(e).Copy wb.Sheets(1).Cells(1)
On Error Resume Next
wb.SaveAs ThisWorkbook.Path & "\" & Replace(e, "/", "-") & ".xls"
wb.Close False: Set wb = Nothing
Err.Clear
Next
End With
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Subklin89
Klin89, quand j'ouvre ton fichier et que je clic sur "macro1" ou macro2" rien se passe...
re
il n'y a ren de tout cuit avec Excel
puisque tu t'ennivres facilement
met ton vrai fichier a khin en message perso et si il veux bien t'arranger le coup : c'est bon
sinon adresse toi a un cabinet de developpeurs ; ils te feront çà pil poil mais ton budget" vacance" s'en trouvera amputé
alors :applique toi ;analyse un peu ,je suis sur que le cri du billet de 50 boules arraché de ton porte monnaie aura un effet
cordialement
Bonjour à tous,
Merci Klin pour ta macro même si après avoir cherché je n'arrive pas à la faire fonctionner.
Tulipe_4, la formule que tu as mise au point fonctionne parfaitement
Dans la liste déroulante de mon fichier, je sélectionne mon niveau et j'ai créée un bouton "export vers excel" pour avoir un nouveau classeur avec uniquement les valeurs.
Ma question est : est ce possible de rajouter une ligne de code pour faire la somme de la colonne "E", sachant que cette dernière est variable, elle n'a jamais le même nombre de cellules?
Merci pour vos réponses
Bonjour,
J'ai lu que tu débutais sur Excel donc je te propose deux solutions :
La plus simple, qui parait évidente et que je pense que tu connais (mais qui a comme défaut qu'il faut étendre sur tout le tableau de valeurs), utiliser une formule :
=SOMME(E5:E100)Mais si tu dois le refaire à chaque changement de fichiers ou de feuilles, ça risque de devenir rapidement pénible.
La deuxième, en restant dans du simple, avec VBA :
Sub Somme()
'On déclare la variable s en Single, cela correspond au contenu et à la taille de ta variable, ici des chiffres/nombres à virgule
'(Integer et Long pour les entiers, ...)
Dim s As Single
'On initialise la variable de la somme
s = 0
'On trouve la dernière ligne remplie de la colonne E
DerniereLigne = Cells(Rows.Count, 5).End(xlUp).Row
'On fait une boucle de la première valeur à la dernière (ici les valeurs sont lignes 5, donc on part de 5)
For i = 5 To DerniereLigne
s = s + Cells(i, 5).Value
Next i
'On met le contenu de s dans une cellule
Range("M5") = s
End SubC'est court, c'est propre, c'est facilement personnalisable. Dans une macro cela demande de mettre à jour en lançant la macro, mais tu peux l'incorporer aussi dans le code déjà éxistant ou sur la feuille avec des conditions sur l'activation.
Bonjour Timothe et merci!
J'ai rajouté tes lignes à la suite de la macro j'ai un message d'erreur, fausse manipulation de ma part?
Essaie de déplacer le Dim s as Single en haut de ta feuille, juste en dessous du Private Sub
On déclare les variables au début.
Timothe URVOY a écrit :Essaie de déplacer le Dim s as Single en haut de ta feuille, juste en dessous du Private Sub
On déclare les variables au début.
J'ai également le même message d'erreur.
Mmm, étrange, j'ai repris le fichier de klin89, 2 ème version (qui à l'air de fonctionner : enregistre un dossier par niveau trié) et je dis juste de faire la macro somme en l'appellant juste avant la fin (les deux fonctionnent) :
Sub Creation_classeurs2()
Dim rng As Range, i As Long, e, wb As Workbook
Application.ScreenUpdating = False
Set rng = Sheets("Feuil1").Range("a4").CurrentRegion
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 2 To rng.Rows.Count
If Not .exists(rng.Cells(i, 6).Value) Then
Set .Item(rng.Cells(i, 6).Value) = _
Union(rng.Rows(1), rng.Rows(i))
Else
Set .Item(rng.Cells(i, 6).Value) = _
Union(.Item(rng.Cells(i, 6).Value), rng.Rows(i))
End If
Next
Application.DisplayAlerts = False
For Each e In .keys
Set wb = Workbooks.Add
.Item(e).Copy wb.Sheets(1).Cells(1)
On Error Resume Next
wb.SaveAs ThisWorkbook.Path & "\" & Replace(e, "/", "-") & ".xls"
wb.Close False: Set wb = Nothing
Err.Clear
Next
End With
Somme
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Voilà comment se présente mon module, j'ai essayé d'expliquer le plus possible pour que vous compreniez le fonctionnement des macros
Le schéma est bien expliqué, j'ai fait ce que vous avez marqué pourtant sur les fichiers générés je n'ai pas de somme pour la colonne E.
Oui parceque sur cet exemple on appelle la fonction après avoir fermé les fichiers (en bleu), donc la somme se fait sur le fichier d'origine, pour qu'il le fasse sur les autres fichiers il faut appeller Somme juste avant qu'il ne sauvegarde puis ferme (en orange). (et penser à changer un petit peu la Macro vu qu'ici on les valeurs commencent ligne 2)
Merci les sommes fonctionnent
La somme calculée se met automatiquement en M5 : Range("M5") = s, je souhaiterai qu'elle se mette deux cellules à la suite de la dernière de la conne E, est ce possible (sachant que cette colonne est variable...)?
On utilise la variable DerniereLigne à laquelle on a assigné le code qui renvoie la dernière ligne non vide d'une colonne (ici la colonne 5) : DerniereLigne = Cells(Rows.Count, 5).End(xlUp).Row
Concrétement Excel part de la dernière valeur de la colonne 5 : E1048576, donc du bas du tableau (taille max d'un classeur excel) et remonte pour trouver la première cellule non vide de la colonne, il renvoie le numéro de cette ligne. On a juste à demander à Excel de placer la somme 2 cellules plus bas.
Cells(DerniereLigne + 2, 5) = s
(Range sert pour quand on écrit "A1", Cells quand on écrit (1,1), je ne rentre pas trop dans les détails mais de l'un à l'autre on donne la colonne ou la ligne en premier)
Sub Somme()
'On déclare la variable s en Single, cela correspond au contenu et à la taille de ta variable, ici des chiffres/nombres à virgule
Dim s As Single
'On initialise la variable de la somme
s = 0
'On trouve la dernière ligne remplie de la colonne E
DerniereLigne = Cells(Rows.Count, 5).End(xlUp).Row
'On fait une boucle de la première valeur à la dernière (ici les valeurs sont lignes 5, donc on part de 5)
For i = 2 To DerniereLigne
s = s + Cells(i, 5).Value
Next i
'On met le contenu de s deux cellules après la dernière valeur
Cells(DerniereLigne + 2, 5) = s
End SubQue dire à pars encore une fois merci!
La macro de Link_ se base sur 4 niveaux (colonne F : nmc; nmc/ casino vacances ect...), mon fichiers de base en compte une trentaine et plus de 3000 lignes.
J'ai fait un copier coller de la macro mais forcement j'ai une erreur, c'est a qu'elle endroit que pause le problème?
Quel est le message d'erreur ? (une capture d'écran ?)
Je fais tourner le programme avec ça, cela fonctionne, je retrouve les sommes sur les nouveaux fichiers.
Sub Creation_classeurs2()
Dim rng As Range, i As Long, e, wb As Workbook
Application.ScreenUpdating = False
Set rng = Sheets("Feuil1").Range("a4").CurrentRegion
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 2 To rng.Rows.Count
If Not .exists(rng.Cells(i, 6).Value) Then
Set .Item(rng.Cells(i, 6).Value) = _
Union(rng.Rows(1), rng.Rows(i))
Else
Set .Item(rng.Cells(i, 6).Value) = _
Union(.Item(rng.Cells(i, 6).Value), rng.Rows(i))
End If
Next
Application.DisplayAlerts = False
For Each e In .keys
Set wb = Workbooks.Add
.Item(e).Copy wb.Sheets(1).Cells(1)
On Error Resume Next
Somme
wb.SaveAs ThisWorkbook.Path & "\" & Replace(e, "/", "-") & ".xls"
wb.Close False: Set wb = Nothing
Err.Clear
Next
End With
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub Somme()
'On déclare la variable s en Single, cela correspond au contenu et à la taille de ta variable, ici des chiffres/nombres à virgule
Dim s As Single
'On initialise la variable de la somme
s = 0
'On trouve la dernière ligne remplie de la colonne E
DerniereLigne = Cells(Rows.Count, 5).End(xlUp).Row
'On fait une boucle de la première valeur à la dernière (ici les valeurs sont lignes 5, donc on part de 5)
For i = 2 To DerniereLigne
s = s + Cells(i, 5).Value
Next i
'On met le contenu de s dans une cellule
Cells(DerniereLigne + 2, 5) = s
End SubOui thimote ce que tu as mis en place fonctionne sans message d'erreur avec le fichier de base.
J'ai voulu faire la même chose sur mon fichier qui est exactement le même sauf qu'il contient 3000 lignes avec une trentaine de niveau.
J'ai donc ce message :
Voyez vous une ligne surligné en jaune avec le code lors du message d'erreur ? (si c'est le cas se sera plus simple de voir d'où ça viens)
Existe-t'il une feuille ("Feuil1"), une partie de ce code repose dessus, si elle n'éxiste pas c'est peut être ce qui fais bug.
Sinon il y a toujours la solution d'essayer en réduisant la taille, voir si cela marche, ou de faire le code pas à pas (click gauche sur la barre grise à côté du code, un point rouge est censé apparaitre, essayer de mettre la fenètre de code sur la moitié de l'écran, le classeur de l'autre, moitié/moitié. Lancer normalement la macro et le faire pas à pas, en appuyany sur la touche F8, jusqu'à ce que cela bug). Penser à réduire la taille des valeurs puisque pas à pas cela prend du temps (un fichier où de 30 à 3000 valeurs le code bug de la même manière, c'est pas la peine de faire des boucles de 3 plombes, sauf si on aime trouver le temps long).
Effectivement l'erreur venait ici :Set rng = Sheets("Feuil1").Range("a4").CurrentRegion.
Je n'avais pas mis le bon nom de la feuille...
En tout cas tout fonctionne sur mon fichier, juste un petit soucis de rien du tout, sur certains fichiers générés, la durée n'apparait pas en heure, la modification se fait dans la macro (ça reste un détail)?