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

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
'

LupinConfiguration: Windows XP Internet Explorer 6.0

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) ].

LupinConfiguration: Windows XP Internet Explorer 6.0

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,

NtaConfiguration: Windows XP Internet Explorer 7.0

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,

NtaConfiguration: Windows XP Internet Explorer 7.0

Bonjour moi aussi jai de probleme des formule