recherche du max et du min de la colonne 8 de tts les feuilles du classeur

Le
j.elmaghnouji
Bonjour à 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 ça
mais ça 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 = Ctr + 1
Open "D:tata" & Ctr & ".CPT" For Output As #1

Set wrksht = ActiveWorkbook.Worksheets("sh")
Set objListCol = wrksht.ListObjects(sh).ListColumns(8)

Debug.Print objListCol.ListDataFormat.MaxNumber

Next sh


End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
FdeCourt
Le #5441091
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.
j.elmaghnouji
Le #5441081
On 15 avr, 17:23, 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(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
Le #5441061
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
Le #5441031
On 15 avr, 17:58, 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.


ç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
Le #6429261
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.
Publicité
Poster une réponse
Anonyme