Insérer des formules de calcul par VBA Résolu

Question

Bonjour,
j'ai fais une marco Excel et je cherche à insérer dans certaines colonnes de mon tableau une formule de calcul style:
=SI(ET(ESTVIDE(C7);ESTVIDE(B7));"";SI(B7="";C7;SI(C7="";-B7;C7-B7)))
comment faire pour la traduire en vba? faut il tout traduire, pas à pas la formule où il y a t-il une façon plus simple et plus directe?

Merci d'avance,

Nta

Utilisateur anonyme · Accepted Answer

Bonjour,

Suggestion :

Traité la formule comme une chaine de caractères, et affecter à la cellule courante :

Créer d'abord votre formule :

[ =SI(ET(ESTVIDE(C7);ESTVIDE(B7));"";SI(B7="";C7;SI(C7="";-B7;C7-B7))) ]

Lancer l'enregistreur de macro et faite un copier coller de votre formule dans une autre cellule.

Vous aurez donc la syntaxe en VBA !

[ "=IF(AND(ISBLANK(R[4]C[1]),ISBLANK(R[4]C)),"""",IF(R[4]C="""",R[4]C[1],IF(R[4]C[1]="""",-R[4]C,R[4]C[1]-R[4]C)))" ]


ensuite vous reformer la chaine de caractère pour en obtenir une formule valide.


Sub InsereFormule()


    Dim Formule As String
    
    ' [ =SI(ET(ESTVIDE(C7);ESTVIDE(B7));"";SI(B7="";C7;SI(C7="";-B7;C7-B7))) ]
    ' [ "=IF(AND(ISBLANK(R[4]C[1]),ISBLANK(R[4]C)),"""",IF(R[4]C="""",R[4]C[1],IF(R[4]C[1]="""",-R[4]C,R[4]C[1]-R[4]C)))" ]
    
    Formule = "=IF(AND(ISBLANK(C7),ISBLANK(B7)),"
    Formule = Formule & """" & """" & ",IF(B7=" & """" & """"
    Formule = Formule & ",C7,IF(C7=" & """" & """" & ",-B7,C7-B7)))"
    
    ActiveCell.Offset(0, 0).Value = Formule

End Sub
'

Lupin

Nta · Answer

Bonjour,
merci pour votre réponse, cela m'est bien utile :)

Je me trouve actuellement face à un autre pb que je n'arrive pas à résoudre.
J'ai un certain nombre de lignes et de colonnes dans un tableau, je voudrai parcourir mon tableau de lignes en lignes par ex et décaler de une cellule vers le bas chaque cellules rencontrées.

Voici mon code: il ne marche pas complètement, certaines cellules ne sont pas recopiées.

For col = 3 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
    For Rw = 5 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
        If Cells(Rw, col) <> "" Then
        Cells(Rw + 1, col) = Cells(Rw, col)
        Cells(Rw, col).Clear
        Rw = Rw + 1
        Else: Rw = Rw + 1
        End If
    Next Rw
    Next col

Peut être pourriez vous me dire ce qui ne marche pas dans mon code.

Merci d'avance,

Nta

Utilisateur anonyme · Answer

Re :

Sub Copier()

    Dim Col As Long, Rw As Long

    For Col = 3 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
        For Rw = 5 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
            If (Cells(Rw, Col).Value <> "") Then
                Cells(Rw + 1, Col).Value = Cells(Rw, Col).Value
                Cells(Rw, Col).Clear
            End If
        Next Rw
    Next Col

End Sub
'

je n'ai pas saisie le pourquoi de :

Sub Copier2()

    Dim Col As Long, Rw As Long

    For Col = 3 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
        For Rw = 5 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
            If (Cells(Rw, Col).Value <> "") Then
                Cells(Rw + 1, Col).Value = Cells(Rw, Col).Value
                Cells(Rw, Col).Clear
                Rw = (Rw + 1) ' ???
            Else: Rw = (Rw + 1) '???
            End If
        Next Rw
    Next Col

End Sub
'

devrait se lire :

Sub Copier3()

    Dim Col As Long, Rw As Long

    For Col = 3 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
        For Rw = 5 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
            If (Cells(Rw, Col).Value <> "") Then
                Cells(Rw + 1, Col).Value = Cells(Rw, Col).Value
                Cells(Rw, Col).Clear
                Rw = (Rw + 1) ' ???
            Else
                Rw = (Rw + 1) '???
            End If
        Next Rw
    Next Col

End Sub
'

ce qui est équivalent à :

Sub Copier4()

    Dim Col As Long, Rw As Long

    For Col = 3 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
        For Rw = 5 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
            If (Cells(Rw, Col).Value <> "") Then
                Cells(Rw + 1, Col).Value = Cells(Rw, Col).Value
                Cells(Rw, Col).Clear
            End If
            Rw = (Rw + 1) 
        Next Rw
    Next Col

End Sub
'

si vraiment la boucle [ For Rw = 5 to ... ] fonctionne, il n'est nul besoin d'incrémenter Rw par [ Rw = (Rw + 1) ].

Lupin

Nta · Answer

Merci pour votre réponse, 
en fait j'avais mis Rw=Rw+1 parce qu'il était possible qu'il y ait plusieurs cellules non vides consécutives dans mon tableau, mais effectivement, cela est bien sans l'incrémentation.

Bonne journée,

Nta

MBIMI · Answer

Bonjour moi aussi jai de probleme des formule

Insérer des formules de calcul par VBA

5 réponses

Votre réponse

Discussions similaires

Newsletters