recherche du max et du min de la colonne 8 de tts les feuilles du classeur
5 réponses
j.elmaghnouji
Bonjour =E0 tous,
je cherche un programme en vb qui permet de recherche le max et le min
de la colonne 8 de tts les feuilles du classeur. j'ai essayer avec =E7a
mais =E7a ne marche pas :
Sub recherche()
Dim wrksht As Worksheet , sh As Worksheet, Ctr As Integer
Dim objListCol As ListColumn
For Each sh In Sheets
Ctr =3D Ctr + 1
Open "D:\tata" & Ctr & ".CPT" For Output As #1
Set wrksht =3D ActiveWorkbook.Worksheets("sh")
Set objListCol =3D wrksht.ListObjects(sh).ListColumns(8)
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
FdeCourt
Salut,
Ne sachant pas ce que tu souhaites faire des résultats, j'ai tout mis dans un tableau, que tu peux ensuite coller dans une feuille, ou dans un fichier texte (si tu lance la macro tel quel, il ne se passera rien sauf dans la fenêtre Execution) :
Sub recherche() Dim temp() Dim k As Long Dim sh As Worksheet Dim MyRange As Range
For Each sh In Sheets With sh Set MyRange = sh.Range("H:H")
k = k + 1 ReDim Preserve temp(1 To 3, 1 To k) temp(1, k) = .Name temp(2, k) = Application.WorksheetFunction.Min(MyRange) temp(3, k) = Application.WorksheetFunction.Max(MyRange) Debug.Print temp(1, k) & " - " & temp(2, k) & " - " & temp(3, k) End With Next sh temp = Application.Transpose(temp)
End Sub
Cordialement,
F.
Salut,
Ne sachant pas ce que tu souhaites faire des résultats, j'ai tout mis
dans un tableau, que tu peux ensuite coller dans une feuille, ou dans
un fichier texte (si tu lance la macro tel quel, il ne se passera rien
sauf dans la fenêtre Execution) :
Sub recherche()
Dim temp()
Dim k As Long
Dim sh As Worksheet
Dim MyRange As Range
For Each sh In Sheets
With sh
Set MyRange = sh.Range("H:H")
k = k + 1
ReDim Preserve temp(1 To 3, 1 To k)
temp(1, k) = .Name
temp(2, k) = Application.WorksheetFunction.Min(MyRange)
temp(3, k) = Application.WorksheetFunction.Max(MyRange)
Debug.Print temp(1, k) & " - " & temp(2, k) & " - " &
temp(3, k)
End With
Next sh
temp = Application.Transpose(temp)
Ne sachant pas ce que tu souhaites faire des résultats, j'ai tout mis dans un tableau, que tu peux ensuite coller dans une feuille, ou dans un fichier texte (si tu lance la macro tel quel, il ne se passera rien sauf dans la fenêtre Execution) :
Sub recherche() Dim temp() Dim k As Long Dim sh As Worksheet Dim MyRange As Range
For Each sh In Sheets With sh Set MyRange = sh.Range("H:H")
k = k + 1 ReDim Preserve temp(1 To 3, 1 To k) temp(1, k) = .Name temp(2, k) = Application.WorksheetFunction.Min(MyRange) temp(3, k) = Application.WorksheetFunction.Max(MyRange) Debug.Print temp(1, k) & " - " & temp(2, k) & " - " & temp(3, k) End With Next sh temp = Application.Transpose(temp)
End Sub
Cordialement,
F.
j.elmaghnouji
On 15 avr, 17:23, FdeCourt wrote:
Salut,
Ne sachant pas ce que tu souhaites faire des résultats, j'ai tout mis dans un tableau, que tu peux ensuite coller dans une feuille, ou dans un fichier texte (si tu lance la macro tel quel, il ne se passera rien sauf dans la fenêtre Execution) :
Sub recherche() Dim temp() Dim k As Long Dim sh As Worksheet Dim MyRange As Range
For Each sh In Sheets With sh Set MyRange = sh.Range("H:H")
k = k + 1 ReDim Preserve temp(1 To 3, 1 To k) temp(1, k) = .Name temp(2, k) = Application.WorksheetFunction.Min(M yRange) temp(3, k) = Application.WorksheetFunction.Max(M yRange) Debug.Print temp(1, k) & " - " & temp(2, k) & " - " & temp(3, k) End With Next sh temp = Application.Transpose(temp)
End Sub
Cordialement,
F.
merci pour ta réponse, je voudrai effectivement les mettre dans fichier texte "c:mes documentstoto.txt", j'ai essayer mais ça ne marche pas, j'ai du faire une bétise
On 15 avr, 17:23, FdeCourt <fdeco...@gmail.com> wrote:
Salut,
Ne sachant pas ce que tu souhaites faire des résultats, j'ai tout mis
dans un tableau, que tu peux ensuite coller dans une feuille, ou dans
un fichier texte (si tu lance la macro tel quel, il ne se passera rien
sauf dans la fenêtre Execution) :
Sub recherche()
Dim temp()
Dim k As Long
Dim sh As Worksheet
Dim MyRange As Range
For Each sh In Sheets
With sh
Set MyRange = sh.Range("H:H")
k = k + 1
ReDim Preserve temp(1 To 3, 1 To k)
temp(1, k) = .Name
temp(2, k) = Application.WorksheetFunction.Min(M yRange)
temp(3, k) = Application.WorksheetFunction.Max(M yRange)
Debug.Print temp(1, k) & " - " & temp(2, k) & " - " &
temp(3, k)
End With
Next sh
temp = Application.Transpose(temp)
End Sub
Cordialement,
F.
merci pour ta réponse, je voudrai effectivement les mettre dans
fichier texte "c:mes documentstoto.txt", j'ai essayer mais ça ne
marche pas, j'ai du faire une bétise
Ne sachant pas ce que tu souhaites faire des résultats, j'ai tout mis dans un tableau, que tu peux ensuite coller dans une feuille, ou dans un fichier texte (si tu lance la macro tel quel, il ne se passera rien sauf dans la fenêtre Execution) :
Sub recherche() Dim temp() Dim k As Long Dim sh As Worksheet Dim MyRange As Range
For Each sh In Sheets With sh Set MyRange = sh.Range("H:H")
k = k + 1 ReDim Preserve temp(1 To 3, 1 To k) temp(1, k) = .Name temp(2, k) = Application.WorksheetFunction.Min(M yRange) temp(3, k) = Application.WorksheetFunction.Max(M yRange) Debug.Print temp(1, k) & " - " & temp(2, k) & " - " & temp(3, k) End With Next sh temp = Application.Transpose(temp)
End Sub
Cordialement,
F.
merci pour ta réponse, je voudrai effectivement les mettre dans fichier texte "c:mes documentstoto.txt", j'ai essayer mais ça ne marche pas, j'ai du faire une bétise
FdeCourt
Ok, alors cela devrait fonctionner et t'afficher dans un fichier texte : Feuil1 - MIN - MAX Feuil2 - MIN - MAX .....
Sub recherche() Dim sh As Worksheet Dim MyRange As Range Dim texte As String
Open "c:mes documentstoto.txt" For Output As #1
For Each sh In Sheets With sh Set MyRange = sh.Range("H:H") texte = .Name & " - " & Application.WorksheetFunction.Min(MyRange) & _ " - " & Application.WorksheetFunction.Max(MyRange) End With Print #1, texte Next sh temp = Application.Transpose(temp)
Close #1 End Sub
Cordialement,
F.
Ok, alors cela devrait fonctionner et t'afficher dans un fichier
texte :
Feuil1 - MIN - MAX
Feuil2 - MIN - MAX
.....
Sub recherche()
Dim sh As Worksheet
Dim MyRange As Range
Dim texte As String
Open "c:mes documentstoto.txt" For Output As #1
For Each sh In Sheets
With sh
Set MyRange = sh.Range("H:H")
texte = .Name & " - " &
Application.WorksheetFunction.Min(MyRange) & _
" - " & Application.WorksheetFunction.Max(MyRange)
End With
Print #1, texte
Next sh
temp = Application.Transpose(temp)
Ok, alors cela devrait fonctionner et t'afficher dans un fichier texte : Feuil1 - MIN - MAX Feuil2 - MIN - MAX .....
Sub recherche() Dim sh As Worksheet Dim MyRange As Range Dim texte As String
Open "c:mes documentstoto.txt" For Output As #1
For Each sh In Sheets With sh Set MyRange = sh.Range("H:H") texte = .Name & " - " & Application.WorksheetFunction.Min(MyRange) & _ " - " & Application.WorksheetFunction.Max(MyRange) End With Print #1, texte Next sh temp = Application.Transpose(temp)
Close #1 End Sub
Cordialement,
F.
j.elmaghnouji
On 15 avr, 17:58, FdeCourt wrote:
Ok, alors cela devrait fonctionner et t'afficher dans un fichier texte : Feuil1 - MIN - MAX Feuil2 - MIN - MAX .....
Sub recherche() Dim sh As Worksheet Dim MyRange As Range Dim texte As String
Open "c:mes documentstoto.txt" For Output As #1
For Each sh In Sheets With sh Set MyRange = sh.Range("H:H") texte = .Name & " - " & Application.WorksheetFunction.Min(MyRange) & _ " - " & Application.WorksheetFunction.Max(MyRange) End With Print #1, texte Next sh temp = Application.Transpose(temp)
Close #1 End Sub
Cordialement,
F.
ça marche nikel,j'ai juste une dernière petite difficulté (qui doit pas en etre une pour toi vu comment tu maitrise), je voudrai afficher le max des max, et le min des min dans ce mm fichier txt
merci beaucoup
On 15 avr, 17:58, FdeCourt <fdeco...@gmail.com> wrote:
Ok, alors cela devrait fonctionner et t'afficher dans un fichier
texte :
Feuil1 - MIN - MAX
Feuil2 - MIN - MAX
.....
Sub recherche()
Dim sh As Worksheet
Dim MyRange As Range
Dim texte As String
Open "c:mes documentstoto.txt" For Output As #1
For Each sh In Sheets
With sh
Set MyRange = sh.Range("H:H")
texte = .Name & " - " &
Application.WorksheetFunction.Min(MyRange) & _
" - " & Application.WorksheetFunction.Max(MyRange)
End With
Print #1, texte
Next sh
temp = Application.Transpose(temp)
Close #1
End Sub
Cordialement,
F.
ça marche nikel,j'ai juste une dernière petite difficulté (qui doit
pas en etre une pour toi vu comment tu maitrise), je voudrai afficher
le max des max, et le min des min dans ce mm fichier txt
Ok, alors cela devrait fonctionner et t'afficher dans un fichier texte : Feuil1 - MIN - MAX Feuil2 - MIN - MAX .....
Sub recherche() Dim sh As Worksheet Dim MyRange As Range Dim texte As String
Open "c:mes documentstoto.txt" For Output As #1
For Each sh In Sheets With sh Set MyRange = sh.Range("H:H") texte = .Name & " - " & Application.WorksheetFunction.Min(MyRange) & _ " - " & Application.WorksheetFunction.Max(MyRange) End With Print #1, texte Next sh temp = Application.Transpose(temp)
Close #1 End Sub
Cordialement,
F.
ça marche nikel,j'ai juste une dernière petite difficulté (qui doit pas en etre une pour toi vu comment tu maitrise), je voudrai afficher le max des max, et le min des min dans ce mm fichier txt
merci beaucoup
FdeCourt
Salut, Je ne sais pas si tu as eu une réponse à ton message, mais dans le doute, voilà une solution.
Sub recherche() Dim sh As Worksheet Dim MyRange As Range Dim texte As String
Open "c:mes documentstoto.txt" For Output As #1
For Each sh In Sheets With sh Set MyRange = sh.Range("H:H") val_min = Application.WorksheetFunction.Min(MyRange) val_max = Application.WorksheetFunction.Max(MyRange)
If IsEmpty(val_min_temp) Then val_min_temp = val_min If val_min_temp > val_min Then val_min_temp = val_min
If IsEmpty(val_mav_temp) Then val_max_temp = val_max If val_max_temp < val_max Then val_max_temp = val_max
texte = .Name & " : valeur minimale : " & _ val_min & _ " / valeur maximale : " & val_max End With Print #1, texte Next sh temp = Application.Transpose(temp)
Print #1, "------------------------" & _ vbCrLf & "Valeur Minimale toutes feuilles confondues : " _ & val_min_temp Print #1, "Valeur Maximale toutes feuilles confondues : " _ & val_max_temp Close #1 End Sub
Désolé de ne pas avoir pu répondre plus tôt. Cordialement, F.
Salut,
Je ne sais pas si tu as eu une réponse à ton message, mais dans le
doute, voilà une solution.
Sub recherche()
Dim sh As Worksheet
Dim MyRange As Range
Dim texte As String
Open "c:mes documentstoto.txt" For Output As #1
For Each sh In Sheets
With sh
Set MyRange = sh.Range("H:H")
val_min = Application.WorksheetFunction.Min(MyRange)
val_max = Application.WorksheetFunction.Max(MyRange)
If IsEmpty(val_min_temp) Then val_min_temp = val_min
If val_min_temp > val_min Then val_min_temp = val_min
If IsEmpty(val_mav_temp) Then val_max_temp = val_max
If val_max_temp < val_max Then val_max_temp = val_max
texte = .Name & " : valeur minimale : " & _
val_min & _
" / valeur maximale : " & val_max
End With
Print #1, texte
Next sh
temp = Application.Transpose(temp)
Print #1, "------------------------" & _
vbCrLf & "Valeur Minimale toutes feuilles confondues : " _
& val_min_temp
Print #1, "Valeur Maximale toutes feuilles confondues : " _
& val_max_temp
Close #1
End Sub
Désolé de ne pas avoir pu répondre plus tôt.
Cordialement,
F.
Salut, Je ne sais pas si tu as eu une réponse à ton message, mais dans le doute, voilà une solution.
Sub recherche() Dim sh As Worksheet Dim MyRange As Range Dim texte As String
Open "c:mes documentstoto.txt" For Output As #1
For Each sh In Sheets With sh Set MyRange = sh.Range("H:H") val_min = Application.WorksheetFunction.Min(MyRange) val_max = Application.WorksheetFunction.Max(MyRange)
If IsEmpty(val_min_temp) Then val_min_temp = val_min If val_min_temp > val_min Then val_min_temp = val_min
If IsEmpty(val_mav_temp) Then val_max_temp = val_max If val_max_temp < val_max Then val_max_temp = val_max
texte = .Name & " : valeur minimale : " & _ val_min & _ " / valeur maximale : " & val_max End With Print #1, texte Next sh temp = Application.Transpose(temp)
Print #1, "------------------------" & _ vbCrLf & "Valeur Minimale toutes feuilles confondues : " _ & val_min_temp Print #1, "Valeur Maximale toutes feuilles confondues : " _ & val_max_temp Close #1 End Sub
Désolé de ne pas avoir pu répondre plus tôt. Cordialement, F.
