VBA - valeurs incrémentielles selon conditions

  • Initiateur de la discussion Initiateur de la discussion Raka
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Raka

XLDnaute Occasionnel
Bonjour !
Dernière ligne droite !
J'ai réalisé quelques macros entre la dernière sur laquelle vous m'avez aidée et celle-ci, et... c'est la dernière de mon document !

Mais elle me pose un souci autour duquel je ne parviens pas à envelopper ma logique.

Je vais donc être clair et précis, le tout en image et code joints et explications ici-même.

J'ai un tableau, donc, celui sur lequel vous m'avez aidé à travailler.
Il se remplit de valeurs, qui se colorent selon une macro.

1595951049206.png

Range = G2:AT354

La macro que je cherche à réaliser et qui me résiste (la coquine), c'est ceci :

Pour chaque ligne, je cheche à afficher en colonne E, Cell.Value =, donc, le total des infos de la ligne 1 des cases vertes. Servant = From 10 to 12, Warrioress = From 10 to 11...
Jusque là c'est facile.

Sachant qu'il y a une deuxième condition à tout ça, ça l'est moins.
Il y a un tableau jumeau en-dessous du premier et qui donne, pour les cases vertes, la valeur NO ou la valeur YES.
1595952356669.png

Ca peut se dériver en 3 possibilités :
Toute la ligne verte en YES
Toute le ligne verte en NO
La partie gauche de la ligne verte en NO et la partie droite en YES. (jamais l'inverse ou dans le désordre).

Ce que je cherche à obtenir à la fin, c'est un résumé de type :
SI uniquement du NO: From ... to ...
Si uniquement du YES: From 1 to ... (la première case en YES tient lieu de 1 to 2)
Si NO puis YES : From ... to ... / From 1 to ...

Et voici la macro que j'ai pondue, qui... eh bien, qui fait n'importe quoi, disons-le 😀
Ca fait 2h que j'essaye de la trafiquer, en vain.

VB:
Sub For_Each_Next_Plage()

Dim FL1 As Worksheet
Dim NivInitial As Long
Dim Niv As Long
Dim NivRb As Long
Dim Ligne As Long
Dim Colonne As Long
Dim Text As String

Set FL1 = Worksheets("Autocalc")
    NivRb = 0
    NivInitial = 0
    Niv = 0
 
 
For Colonne = 7 To 47
    For Ligne = 2 To 355
If Cells(Ligne, Colonne).Interior.Color <> RGB(200, 225, 180) Then
    GoTo nextcolmn
End If
If Cells(Ligne, Colonne).Interior.Color = RGB(200, 225, 180) Then 'si la cellule est colorée
    If Cells(Ligne, Colonne - 1).Interior.Color <> RGB(200, 225, 180) Then 'si c'est la première cellule colorée de la ligne
        If Cells(Ligne + 366, Colonne) = "YES" Then 'si la case est en OUI, on rajoute un niveau Rb sinon on définit le niveau initial non-Rb
            NivRb = NivRb + 1
        Else
            NivInitial = Colonne - 6
            Niv = Colonne - 6
        End If
    Else 'c'est pas la premiere cellule colorée de sa ligne
        If Cells(Ligne + 366, Colonne) = "YES" Then
            NivRb = NivRb + 1
        Else
            If Cells(Ligne + 366, Colonne) = "NO" Then
                Niv = Niv + 1
            End If
        End If
    End If
End If

Redo:

If NvRb = 0 Then
    Text = "From " & NivInitial & " to " & Niv
    Cells(Ligne, 5) = Text 'affichage du résumé

Else
    If NvRb <> 0 Then
        Text = "From " & NivInitial & " to " & Niv & " RB 1 to " & NvRb
        Cells(Ligne, 5) = Text ' affichage du résumé

    End If
End If
Next
nextcolmn:
    NivRb = 0
    NivInitial = 0
    Niv = 0
Next


End Sub

Il y a forcément des choses mal faites ou mal pensées, mais... autant je suis arrivé à corriger moi-même les deux dernières que j'ai faites, autant celle-ci... je sèche.

Actuellement, il me raconte n'importe quoi et ne s'occupe même pas du tableau entier.
1595952735577.png


Si c'est pas clair, je rajouterai un fichier joint, une fois que j'aurai réussi à le dépatouiller de tout le superflu pour ne laisser que ça...

Edit ; bon, j'ai résolu des trucs tout seul, me reste encore un souci majeur, je pense que je vais y arriver tôt ou tard...
 

Pièces jointes

  • 1595951496887.png
    1595951496887.png
    2.3 KB · Affichages: 43
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
234
Réponses
4
Affichages
177
Réponses
10
Affichages
281
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
477
Réponses
5
Affichages
232
Retour