Séparer en plusieurs morceaux une formule en VBA

Bonjour tout le monde,

Je souhaiterai séparer en 6 ma formule car elle se répète. En effet, ma problématique est que si je mets toute la formule d'un coup, elle est trop longue et ne fonctionne pas...

Voilà ma formule :

If Cells(11, 4) = Cells(15, 19) And Cells(11, 5) = Cells(15, 20) And Cells(11, 4) = Cells(15, 21) And Cells(11, 5) = Cells(15, 22) And Cells(11, 4) = Cells(15, 23) And Cells(11, 5) = Cells(15, 24)"&
"and Cells(12, 4) = Cells(16, 19) And Cells(12, 5) = Cells(16, 20) And Cells(12, 4) = Cells(16, 21) And Cells(12, 5) = Cells(16, 22) And Cells(12, 4) = Cells(16, 23) And Cells(12, 5) = Cells(16, 24)"&
"and Cells(13, 4) = Cells(17, 19) And Cells(13, 5) = Cells(17, 20) And Cells(13, 4) = Cells(17, 21) And Cells(13, 5) = Cells(17, 22) And Cells(13, 4) = Cells(17, 23) And Cells(13, 5) = Cells(17, 24)"&
"and Cells(14, 4) = Cells(18, 19) And Cells(14, 5) = Cells(18, 20) And Cells(14, 4) = Cells(18, 21) And Cells(14, 5) = Cells(18, 22) And Cells(14, 4) = Cells(18, 23) And Cells(14, 5) = Cells(18, 24)"&
"and Cells(15, 4) = Cells(19, 19) And Cells(15, 5) = Cells(19, 20) And Cells(15, 4) = Cells(19, 21) And Cells(15, 5) = Cells(19, 22) And Cells(15, 4) = Cells(19, 23) And Cells(15, 5) = Cells(19, 24)"&
"and Cells(16, 4) = Cells(20, 19) And Cells(16, 5) = Cells(20, 20) And Cells(16, 4) = Cells(20, 21) And Cells(16, 5) = Cells(20, 22) And Cells(16, 4) = Cells(20, 23) And Cells(16, 5) = Cells(20, 24)"&
" Then Cells(8, 19) = "ok" Else Cells(8, 19) = "ko" "

J'ai essayé de mettre un & et des guillemets mais ça ne fonctionne pas, comment faire ?

Merci d'avance.

Bonjour,

Au lieu de mettre une formule que personne ne prendra le temps d'étudier, place un fichier exemple avec des données non confidentielles et le résultat que tu voudrais obtenir avec quelques explications.

Je pense que cela sera plus rapide

Bonjour,

A tester :

Sub ResultatCelluleS8()

Dim I As Integer, J As Integer
Dim Tab4 As Variant, Tab5 As Variant
Dim Resultat As Boolean

    With ActiveSheet

        Resultat = True
        Tab4 = Array(19, 21, 23)
        Tab5 = Array(20, 22, 24)

        For I = 11 To 16
            For J = LBound(Tab4) To UBound(Tab4)
                 If .Cells(I, 4) <> .Cells(I + 4, Tab4(J)) Then
                  Resultat = False
                  Exit For
                End If
            Next J

            For J = LBound(Tab5) To UBound(Tab5)
                If .Cells(I, 5) <> .Cells(I + 4, Tab5(J)) Then
                  Resultat = False
                  Exit For
                End If
            Next J

            If Resultat = False Then Exit For
        Next I

        If Resultat = True Then
            .Cells(8, 19) = "ok"
        Else
            .Cells(8, 19) = "ko"
        End If

    End With

End Sub

Merci, il y a juste un pb la cellule affiche toujours ko même quand les données sont bonnes. Tu as une idée pour savoir d'où ça vient ?

Te reporter à ce qu'a écrit M12.

Bonjour Eric

Teste cette macro

Sub test()
 Dim i%, j%, col%
   i = 11
    For j = 19 To 25
      For col = 19 To 24
        If Cells(i, 4) = Cells(j, col) Then
          Cells(8, 19) = "OK"
        Else
          Cells(8, 19) = "KO"
          Exit Sub
        End If
      Next col
      i = i + 1
    Next j
End Sub

Voilà ce que je cherche à faire...

image

@M12 : Je n'ai aucunes données dans mon tableau pour tester.

A défaut de données, un code pour mettre en évidence les cellules Ko

Sub ResultatCelluleS8()

Dim I As Integer, J As Integer
Dim Tab4 As Variant, Tab5 As Variant
Dim Resultat As Boolean

    With ActiveSheet

        Resultat = True
        Tab4 = Array(19, 21, 23)
        Tab5 = Array(20, 22, 24)

        For I = 11 To 16
            For J = LBound(Tab4) To UBound(Tab4)
                .Cells(I, 4).Interior.ColorIndex = xlNone
                .Cells(I + 4, Tab4(J)).Interior.ColorIndex = xlNone

                 If .Cells(I, 4) <> .Cells(I + 4, Tab4(J)) Then
                    .Cells(I, 4).Interior.Color = RGB(255, 255, 0)
                    .Cells(I + 4, Tab4(J)).Interior.Color = RGB(255, 0, 0)
                  Resultat = False
                '  Exit For
                End If
            Next J

            For J = LBound(Tab5) To UBound(Tab5)
                 .Cells(I, 5).Interior.ColorIndex = xlNone
                 .Cells(I + 4, Tab5(J)).Interior.ColorIndex = xlNone

                If .Cells(I, 5) <> .Cells(I + 4, Tab5(J)) Then
                 .Cells(I, 5).Interior.Color = RGB(255, 255, 0)
                 .Cells(I + 4, Tab5(J)).Interior.Color = RGB(255, 0, 0)
                  Resultat = False
                '  Exit For
                End If
            Next J

          '  If Resultat = False Then Exit For
        Next I

        If Resultat = True Then
            .Cells(8, 19) = "ok"
        Else
            .Cells(8, 19) = "ko"
        End If

    End With

End Sub

Bonjour Eric je n'ai pris qu'une capture d'écran car si peu de données dans excel dépasse déjà les 1,5mo (la capacité max pour vous le transmettre).

As-tu essayé le dernier code transmis ? Il met en évidence les cellules qui ne sont pas égales.

Re,

Décidement... ça m'affiche toujours un ko, je précise que les valeurs sont biens saisies en brut. Je ne comprends d'où le problème peut bien provenir :-I

Combien de cellules coloriées ? J'imagine toutes.

Aucune cellule de colorées en revanche le ko est là

Je te remets une nouvelle capture d'écran avec cette fois les colonnes et les lignes

image
Rechercher des sujets similaires à "separer morceaux formule vba"