XL 2010 Boucle sur chaque Cellule d'une rangée VBA

sams96

XLDnaute Nouveau
Bonjour à tous ,
je viens vers vous car je bloque pour faire une boucle ,
je cherche à faire une boucle qui va d'abord parcourir toute la colonne A ( Catégorie) , puis à chaque fois ou cette boucle trouve un texte en gras , elle devra parcourir toute ses sous catégories et afficher dans la colonne H et l la sous catégorie ayant la valeur la plus élevée , j ai mis un exemple du résultat que je recherche sur le fichier excel ,
prière de bien vouloir m'aider .
 

Pièces jointes

  • Copie de ess.xlsx
    10 KB · Affichages: 14

clq

XLDnaute Nouveau
D'accord, c'est un fichier évolutif ou non ? Je veux dire par là qu'il n'y a que 3 sous catégories et valeurs en H et I ? Ta colonne A sera vide entre deux cases de catégorie ?
Et envoi ce que tu as déjà pour voir si on peut rattraper dessus ce sera plus simple :)
 

sams96

XLDnaute Nouveau
voila le code que j ai essayer de faire
' Select Last row

Lr = wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row


' Boucle Top 5 :

Dim myRange As Range

Dim cell As Range

Set myRange = wb.Sheets(1).Range("A1:A" & Lr)

For Each cell In myRange.Cells

If cell.Font.Bold = True Then wb.Sheets(1).Cells()
 

job75

XLDnaute Barbatruc
Bonjour sams96, clq,

Voyez le fichier joint et le code du bouton :
VB:
Private Sub CommandButton1_Click() 'bouton Maxima
Dim tablo, ub&, resu(), minimax#, i&, a(1 To 2), j&, n&
tablo = UsedRange.Resize(UsedRange.Rows.Count + 1, 3) 'matrice, plus rapide
ub = UBound(tablo)
ReDim resu(1 To ub, 1 To 2)
minimax = -10 ^ 99
For i = 1 To ub
    If tablo(i, 1) <> "" Then
        a(1) = ""
        a(2) = minimax
        For j = i + 1 To ub
            If IsNumeric(CStr(tablo(j, 3))) And tablo(j, 3) > a(2) Then
                a(1) = tablo(j, 2)
                a(2) = tablo(j, 3)
            ElseIf tablo(j, 3) = "" Then
                If a(2) > minimax Then
                    n = n + 1
                    resu(n, 1) = a(1)
                    resu(n, 2) = a(2)
                End If
                i = j - 1
                Exit For
            End If
        Next j
    End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [H3] 'cellule à adapter
    If n Then .Resize(n, 2) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ en dessous
End With
End Sub
L'exécution est très rapide car on utilise des tableaux VBA.

A+
 

Pièces jointes

  • Copie de ess(1).xlsm
    28.4 KB · Affichages: 8
Dernière édition:

sams96

XLDnaute Nouveau
Merci bcp job 75 pour ta réponse, le code marche parfaitement
Mais est ce qu il serait de me l expliquer plus en détail , notamment la variable minimax , Usedrange.rows.count et le résu ( n,1)
Entres autres elles servent à quoi ?
 

job75

XLDnaute Barbatruc
La variable minimax initialise a(2) pour chaque boucle j qui sert à déterminer le maximum.

UsedRange.Rows.Count c'est le nombre de ligne du UsedRange (on étudie une ligne de plus).

resu(n, 1) c'est la valeur en ligne n et colonne 1 du tableau resu qui est le tableau des résultats.
 

sams96

XLDnaute Nouveau
Je comprends toujours pas votre code , est ce qu il serait possible de le détaillé un peu plus
Private Sub CommandButton1_Click() 'bouton Maxima
Dim tablo, ub&, resu(), minimax#, i&, a(1 To 2), j&, n&
tablo = UsedRange.Resize(UsedRange.Rows.Count + 1, 3) 'matrice, plus rapide ( 1 /Prk crée cette matrice ? , elle sert à quoi ?
ub = UBound(tablo)
ReDim resu(1 To ub, 1 To 2)
minimax = -10 ^ 99 (2 / pourqoui prendre cette valeur pour minimax ? )
For i = 1 To ub
If tablo(i, 1) <> "" Then
a(1) = ""
a(2) = minimax ( prk a(1) = vide et a(2)= Minimax )
For j = i + 1 To ub
If IsNumeric(CStr(tablo(j, 3))) And tablo(j, 3) > a(2) Then ( Elle sert à quoi cette condition if )
a(1) = tablo(j, 2) (prk mettre a(1) ) tablo (j,2)

a(2) = tablo(j, 3) et a(2) = tablo (j,2)
ElseIf tablo(j, 3) = "" Then
If a(2) > minimax Then prk if ici ?
n = n + 1
resu(n, 1) = a(1)
resu(n, 2) = a(2)
End If
i = j - 1
Exit For
End If
Next j
End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [H3] 'cellule à adapter
If n Then .Resize(n, 2) = resu
.Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ en dessous
End With
End Sub
 

job75

XLDnaute Barbatruc
Le VBA n'est pas indispensable, vous comprendrez peut-être mieux avec une solution par formules, voyez le fichier joint.

Les colonnes D et E sont utilisées comme colonnes auxiliaires.

Les formules en colonnes H et I sont matricielles, validées par Ctrl+Maj+Entrée.

La limite (ligne 1000) des plages doit être augmentée si nécessaire.
 

Pièces jointes

  • ess par formules(1).xlsx
    17.2 KB · Affichages: 5

Discussions similaires

Statistiques des forums

Discussions
311 722
Messages
2 081 930
Membres
101 843
dernier inscrit
Thaly