Posez votre question Format imprimable Liste des forums Aidez-les Statistiques Rechercher Charte Forum Programmation

Insérer des formules de calcul par VBA

Dernière réponse le 25 nov 2008 à 09:03:08 Nta, le 24 aoû 2007 à 12:08:05

Signaler ce message aux modérateurs

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

Posez votre question Répondre

Lupin.A, le 24 aoû 2007 à 16:28:45

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

Configuration: Windows XP
Internet Explorer 6.0

Répondre à Lupin.A

Nta, le 27 aoû 2007 à 16:27:01

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

Configuration: Windows XP
Internet Explorer 7.0

Répondre à Nta

Lupin.A, le 27 aoû 2007 à 19:15:28

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

Configuration: Windows XP
Internet Explorer 6.0

Répondre à Lupin.A

Nta, le 28 aoû 2007 à 08:53:06

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

Configuration: Windows XP
Internet Explorer 7.0

Répondre à Nta

MBIMI, le 25 nov 2008 à 09:03:08

Bonjour moi aussi jai de probleme des formule

Répondre à MBIMI

Posez votre question Répondre