Discussion :

[lucarno]

Bonjour,

Je voudrais transmettre un test à des cellules, mais je peine un peu.

La macro plante avec le message :"Erreur définie par l'application ou l'objet", à la ligne en gras dans ce message.

Voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Sub ValeursActuelles_Click()
    Dim CelluleCourante As Range
    Dim Debloc, Frais, IntInt, Ech, NumEch, Ass
    
    Worksheets("tableau amortiss").Activate
    Set CelluleCourante = ActiveSheet.Range("A61")
    
    Do While Not IsEmpty(CelluleCourante) = True
        Debloc = CelluleCourante.Offset(0, 1).Value
        Frais = CelluleCourante.Offset(0, 2).Value
        IntInt = CelluleCourante.Offset(0, 5).Value
        Ech = CelluleCourante.Offset(0, 8).Value
        NumEch = CelluleCourante.Offset(0, 10).Value
        Ass = CelluleCourante.Offset(0, 6).Value
        
        'Valeur actuelle hors frais et hors assurance
        CelluleCourante.Offset(0, 12).Value = "=SI(" & Debloc & "<> 0 ;" & Debloc & ";SI(" & Ech & "<> 0;" & Ech & "*(1+$Q$34)^(-" & NumEch & ");0))"
        'Valeur actuelle hors assurance
        CelluleCourante.Offset(0, 13).Value = "=SI(" & Debloc & "<> 0 ;" & Debloc & ";SI(" & Frais & "<> 0 ;" & Frais & ";SI(" & Ech & "<> 0 ;" & Ech & "*(1+$Q$22)^(-(" & NumEch & "/12));0)))"
        'Valeur actuelle assurance comprise
        CelluleCourante.Offset(0, 14).Value = "=SI(" & Debloc & "<> 0 ;" & Debloc & ";SI(" & Frais & "<> 0 ;" & Frais & ";SI(" & Ech & "<> 0 ;" & Ech & "*(1+$Q$42)^(-(" & NumEch & "/12))+" & Ass & ";0)))"
        
        If CelluleCourante.Offset(0, 1).Value <> 0 Then
        End If
        Set CelluleCourante = CelluleCourante.Offset(1, 0)
    Loop
End Sub

Je voudrais que le test entre intégralement dans les cellules avec les valeurs de Debloc, Frais, etc, ... pour pouvoir ensuite calculer avec la valeur cible dans le fichier Excel.

Merci de votre aide.

[MarcelG]

Bonjour à toi, Bonjour le Forum,

C'est la méthode

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Value

qui me choque un peu.

Ne serait-ce pas plutôt

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Formula

.

De plus, à quoi sert de boucler sur une seule cellule (ici A61) ?

[mercatog]

Plutôt FormulaLocal et les variables Range
Il y a d'autres façons
Ci-joint ton code modifié

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub ValeursActuelles_Click()
Dim CelluleCourante As Range, Debloc As Range, Frais As Range, IntInt As Range, Ech As Range, NumEch As Range, Ass As Range
 
Set CelluleCourante = Worksheets("tableau amortiss").Range("A61")
Do While Not IsEmpty(CelluleCourante)
    Set Debloc = CelluleCourante.Offset(0, 1)
    Set Frais = CelluleCourante.Offset(0, 2)
    Set IntInt = CelluleCourante.Offset(0, 5)
    Set Ech = CelluleCourante.Offset(0, 8)
    Set NumEch = CelluleCourante.Offset(0, 10)
    Set Ass = CelluleCourante.Offset(0, 6)
 
'Valeur actuelle hors frais et hors assurance
    CelluleCourante.Offset(0, 12).FormulaLocal = "=SI(" & Debloc.Address & "<> 0 ;" & Debloc.Address & ";SI(" & Ech.Address & "<> 0;" & Ech.Address & "*(1+$Q$34)^(-" & NumEch.Address & ");0))"
'Valeur actuelle hors assurance
    CelluleCourante.Offset(0, 13).FormulaLocal = "=SI(" & Debloc.Address & "<> 0 ;" & Debloc.Address & ";SI(" & Frais.Address & "<> 0 ;" & Frais.Address & ";SI(" & Ech.Address & "<> 0 ;" & Ech.Address & "*(1+$Q$22)^(-(" & NumEch.Address & "/12));0)))"
'Valeur actuelle assurance comprise
    CelluleCourante.Offset(0, 14).FormulaLocal = "=SI(" & Debloc.Address & "<> 0 ;" & Debloc.Address & ";SI(" & Frais.Address & "<> 0 ;" & Frais.Address & ";SI(" & Ech.Address & "<> 0 ;" & Ech.Address & "*(1+$Q$42)^(-(" & NumEch.Address & "/12))+" & Ass.Address & ";0)))"
    Set CelluleCourante = CelluleCourante.Offset(1, 0)
Loop
End Sub

Ou avec les addresses

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub ValeursActuelles_Click()
Dim CelluleCourante As Range
Dim Debloc As String, Frais As String, IntInt As String, Ech As String, NumEch As String, Ass As String
 
Set CelluleCourante = Worksheets("tableau amortiss").Range("A61")
Do While Not IsEmpty(CelluleCourante)
    Debloc = CelluleCourante.Offset(0, 1).Address
    Frais = CelluleCourante.Offset(0, 2).Address
    IntInt = CelluleCourante.Offset(0, 5).Address
    Ech = CelluleCourante.Offset(0, 8).Address
    NumEch = CelluleCourante.Offset(0, 10).Address
    Ass = CelluleCourante.Offset(0, 6).Address
'Valeur actuelle hors frais et hors assurance
    CelluleCourante.Offset(0, 12).FormulaLocal = "=SI(" & Debloc & "<> 0 ;" & Debloc & ";SI(" & Ech & "<> 0;" & Ech & "*(1+$Q$34)^(-" & NumEch & ");0))"
'Valeur actuelle hors assurance
    CelluleCourante.Offset(0, 13).FormulaLocal = "=SI(" & Debloc & "<> 0 ;" & Debloc & ";SI(" & Frais & "<> 0 ;" & Frais & ";SI(" & Ech & "<> 0 ;" & Ech & "*(1+$Q$22)^(-(" & NumEch & "/12));0)))"
'Valeur actuelle assurance comprise
    CelluleCourante.Offset(0, 14).FormulaLocal = "=SI(" & Debloc & "<> 0 ;" & Debloc & ";SI(" & Frais & "<> 0 ;" & Frais & ";SI(" & Ech & "<> 0 ;" & Ech & "*(1+$Q$42)^(-(" & NumEch & "/12))+" & Ass & ";0)))"
    Set CelluleCourante = CelluleCourante.Offset(1, 0)
Loop
Set CelluleCourante = Nothing
End Sub

[lucarno]

Bonjour,

Je ne boucle pas car j'incrémente "CelluleCourante" en fin de boucle.

Je ne connais pas .Formula et ma version d'Excel non plus (je viens d'essayer).

Je pense que je dois rentrer mon affectation dans un mot clé, mais je ne sais pas lequel.

[MarcelG]

Lucarno,

Plouf! Plouf!
J'ai lu trop vite et ta boucle peut se justifier.

Au demeurant, boucler sur des cellules non vides peut s'avérer très vite assez lourd.

Tu peux impacter tes formiules en bloc, pour chaque colonne de calculs.

Un exemple à adapter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Macro1()
 
    Dim lastlign As Integer
    With ActiveSheet
            lastlign = Cells(.Rows.Count, 1).End(xlUp).Row
 
            '1 colonne de calculs (exemple à répéter)
            With .Range("D2:D" & lastlign)
                .FormulaR1C1 = "=RC[-3]*RC[-2]+RC[-1]"
               'Collage spécial de valeurs
                .Value = .Value
             End With
 
    End With
 
End Sub

[lucarno]

Bonjour,

Je viens d'essayer FormulaLocal, mais j'ai toujours la même erreur.

.Address et .FormulaLocal, ça marche.

Merci

[MarcelG]

Pardon de m'immiscer, lucarno et mercatog, mais je pense qu'une formulation globale reste plus performante.

De plus, le code (de toi je crois, mercatog)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Value = .Value

permet d'alléger la formulation.

[lucarno]

Je viens d'essayer le nouveau code, ça marche super bien.

Merci.

[mercatog]

Effectivement MarcelG, c'est un gain de temps en évitant les boucles.
Ci-joint code modifié (je préfère le formula au formulalocal) pour question de portabilité du fichier sur excel non français

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub ValeursActuelles_Click()
Dim LastLig As Long
 
With Worksheets("tableau amortiss")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    If LastLig >= 61 Then
        .Range("M61:M" & LastLig).Formula = "=IF(B61<> 0,B61,IF(I61<> 0,I61*(1+$Q$34)^(-K61),0))"
        .Range("N61:N" & LastLig).Formula = "=IF(B61<> 0,B61,IF(C61<> 0,C61,IF(I61<> 0,I61*(1+$Q$22)^(-(K61/12)),0)))"
        .Range("O61:O" & LastLig).Formula = "=IF(B61<> 0,B61,IF(C61<> 0,C61,IF(I61<> 0,I61*(1+$Q$42)^(-(K61/12))+G61,0)))"
    End If
    'Si on veut remplacer les formules par leurs valeurs
    'Sinon, on supprime la ligne suivante
    .Range("M16:O" & LastLig).Value = .Range("M16:O" & LastLig).Value
End With
End Sub