XL 2013 souci d'affichage des additions

clyde88 · 11 Juillet 2017

Bonjour,

S'il vous plait je suis a la recherche d'une aide précieuse je suis entrain de crééer une feuille de calcul excel en language vba et j'arrive pas afficher dans chaque cellule le résultat de l'addition sachant que j'additionne avec un nombre de pas de 0.5 en démarrant d'un certain nombre comme le montre le tableau ci-dessous je vous envoie aussi mon programme et merci pour votre aide.

Sub itération()

Dim Ninf, profondeur, longueurpieu As Single

Dim cell As Range

Dim x As Integer

Range("G2").Select

ActiveCell.FormulaR1C1 = "=RC[-2]"

Ninf = Range("E2")

longueurpieu = Range("F2")

profondeur = longueurpieu + 0.5

If profondeur > longueurpieu Then

profondeur = longueurpieu

Else: profondeur = profondeur + 0.5

End If

Range("G3") = profondeur

End Sub

vgendron · 23 Août 2017

Hello

Pourrais tu décrire le fonctionnement de ton fichier, car il me semble que le code est redondant.. il y a un test qui se fait 2 ou 3 fois (présence des Z et Pl et Ninf et LPieu....)
le NbreCouche est récupéré 5 ou 6 fois.. suffirait de le mettre en variable public une bonne fois pour toute
sauf s'il est susceptible de changer lorsque tu passes d'une feuille à l'autre..?

Dans la feuille Hypothèse: quand tout est réinitialisé, il faut remplir le nombre de couche et les info Ninf, lpieu et Phi
ensuite. clic sur "1 définir les hypothèses" pour créer le nombre de couches en B, création de la liste de validation en A3 et la meme en C6-->Cnbrcouche et autre liste en B3
-> tu peux donc sélectionner des éléments en A3 B3 C6 C7...
mais si tu reclique sur le meme bouton "1 définir les hypo", le type de sol en C6 est recopié en dessous. donc. ca ecrase ce que tu viens de selectionner...
faut il que toutes les couches soient dans le meme type de sol? auquel cas. on laisse le code écraser
sinon.. peut etre faudrait il empecher de recliquer sur ce bouton tant que tu n'as pas fait un reset.. ?

vgendron · 23 Août 2017

Voir Rev 9

clyde88 · 24 Août 2017

salut l'ami les cases en bleu c'est les paramètre que tu dois saisir après les boutons sont numéroter afin de faciliter le calcul en premier c'est hypothèse il fait appelle à la macro hypothèse de calcul qui t'affiche les listes déroulante et ou tu saisis les z eet les pl après t'as le choix avec pieux ou micropieux si tu choisis pieux il fait appelle à la macro calcul pieux ou il calcul la feuille terme de pointe et frottement après résulats ou il affiche la liste déroulantes en A6 je crois, après tu choisis entre les trois cases afin de te donner le résultat final je te joint deux fichier ou j'ai bidouiller un peu afin que ça marche pour une couche

vgendron · 24 Août 2017

Bonjour
As tu regardé la dernière version que je t'ai envoyée?
visiblement pas, puisque tu remets des fichiers avec du code redondant, mal organisé et quelque peu difficile à lire...
Donc. pour la suite,
reprend la version 9 envoyée hier
fais tes tests avec plusieurs couches ---> est ce toujours OK
fais tes tests avec une coucche--> si ca ne marche pas.. qu'est ce qui ne marche pas? BUG? Erreur de calcul?
et regarde le code: j'y ai mis des commentaires ici et la..

clyde88 · 24 Août 2017

Les cases en vert dans les deux feuilles suivante c'est une copies des de la feuille hypothèse de calcul car j'ai besoin d'utiliser ces paramètre et pas à chaque fois je dois y retourner à la feuille d'hypothèse

vgendron · 24 Août 2017

Regarde la version 10 ci jointe
ouvre le code
et Lis TOUS les commentaires que j'ai écris en fonction de ce que j'ai compris.
Excecute le code pas à pas (touche F8) pour voir ce que fait chaque ligne de code.

Plusieurs questions regroupées ici
1) Dans la feuille Hypothèse: Est il possible/normal d'avoir A3 et C6 différents?
2) Pour le calcul de pieu (dans feuille Calcul terme pointe Rb)
2a) tu écris toutes les formules sur la ligne 6: mais visiblement, elles ne sont pas recopiées sur toutes les couches quand il y en a plusieurs
2b) le calcul de Rs est il bon?: regarde mes commentaires
3) Pour le calcul de MicroPieu (feuille frottement axial Qs)
3a) la. les formules sont bien recopiées
3b) meme question pour le calcul de Rs

clyde88 · 24 Août 2017

A3 et la derniere couche doivent etre les meme exemple si on a 3 couches A3=C9
pour la question 2a normale parce que le calcul se fait juste en une seule ligne pas comme pour Rs
pour la question 2b les formules sont bonnes
3a et 3b ok

juste une aide stp pour ple* et DEF j'arrive pas à trouver la bonne condition:

pour la cellule Profondeur de la couche (m) {Ple*}: il prend les profondeurs et les pl: d-b<z<d+3*a et
d-b<pl<d+3*a

après hauteur de la couche (m) {Ple*}: la première valeur de z> d-b => hauteur de la couche =z-(d-b) et (d+3*a)-z et s'il y a plusieurs valeurs de z entre d-b et d+3*a ça sera la petite valeur supérieur (d-b)-(d-b)
après ça sera z2-z jusqu'à est ce que on arrive à D et la en fait d+3*a-D et s'il y a des valeurs entre D et d+3*a ça sera la petite valeur supérieure à D+3*a -D et z2-z

vgendron · 24 Août 2017

Ok pour le début
par contre.. pour ca:

pour la cellule Profondeur de la couche (m) {Ple*}: il prend les profondeurs et les pl: d-b<z<d+3*a et
d-b<pl<d+3*a

après hauteur de la couche (m) {Ple*}: la première valeur de z> d-b => hauteur de la couche =z-(d-b) et (d+3*a)-z et s'il y a plusieurs valeurs de z entre d-b et d+3*a ça sera la petite valeur supérieur (d-b)-(d-b)
après ça sera z2-z jusqu'à est ce que on arrive à D et la en fait d+3*a-D et s'il y a des valeurs entre D et d+3*a ça sera la petite valeur supérieure à D+3*a -D et z2-z

Tu te rends compte que c'est incompréhensible pour quelqu'un qui n'est pas dans le domaine??
il faudrait etre beaucoup plus clair et précis:
QUELLE feuille
Quelles cellules
quelles formules à mettre. (et pas de formule du type Profondeur=d-b *2/ D-hd)
non non. une formule du style:
G5=J3*2/M3
ou
G5=K5+J5
en précisant les conditions pour mettre la première ou seconde formule

clyde88 · 25 Août 2017

hhhhhhhhhhhhhhhhhhh
désolé je vais t'envoyer un fichier avec un exemple

clyde88 · 23 Octobre 2017

Salut l'ami stp je bloque la j'ai un problème de temps de calcul qui est énorme j'ai changé beaucoup de chose dans le programme après j'ai aucune idée comment faire stp j'ai besoin de ton aide.

vgendron · 23 Octobre 2017

Hello
Tu as tellement modifié et ajouté de choses qu'effectivement, ca va être dur d'optimiser tout ca..
déjà. je ne comprend plus rien au code et à ce qu'il fait.. et je vais pas me taper tes 10 modules pour essayer de comprendre en mode pas à pas...

1) il faut plus de clarté dans ton code
--> il faut absolument que tu commentes ton code
--> il faut garder une indentation propre (= décalage des lignes pour bien distinguer les différents blocs: il semble y avoir pas mal de end with qui ne sont pas à leur place.

2) supprimer un maximum de select
exemple
range("A2").select
selection.formula=....
à remplacer directement par
Range("A2").formula=...
supprimer tous les scrolldowns que l'enregistreur t'a collé automatiquement

3) tu peux ajouter un "Application.screenupdating =false" en début de macro
et donc mettre un "Application.screenupdating =true" en fin de macro

ensuite, il y a des boucles inutiles
for i=1 to NbreCouche
cells(i,2).select
with selection.....
end with
next i

à remplacer par
cells(1,2).resize(NbreCouche).select
with..
end with

après. il faudrait que tu identifies les macro ou parties de code qui sont lentes..

Voila. tu as du boulot :-D

clyde88 · 23 Octobre 2017

stp est ce tu peux juste regarder le module 6 partie renitialiser c'est elle la plus lente
merci

vgendron · 23 Octobre 2017

regarde ce code

VB:

Sub Hypothèsedecalcul()
Application.ScreenUpdating = False
Dim x As Single

With Sheets("Hypothèses de Calcul")
    NbreCouche = .Range("A6") 'on récupère les infos d'entrée
    .Range("B6") = 1
    .Range("B6").AutoFill Destination:=Range("B6:B" & 5 + NbreCouche), Type:=xlFillSeries
   
    Ninf = .Range("E3")
    Lpieu = .Range("F3")
    Phi = .Range("G3")
   
    'quelques tests pour vérifier que les infos necessaires sont présentes. sinon. bug macro
   
    If NbreCouche = "" Then
        ManqueInfo = ManqueInfo & " NbreCouche "
    End If
   
    If Ninf = "" Then
        ManqueInfo = ManqueInfo & " Ninf "
    End If
   
    If Lpieu = "" Then
        ManqueInfo = ManqueInfo & " Lpieu "
    End If
   
    If Phi = "" Then
        ManqueInfo = ManqueInfo & " Phi "
    End If
   
    If ManqueInfo <> "" Then
        MsgBox ("il manque des infos: " & ManqueInfo)
    Exit Sub
    End If
End With
   
' on determine le type de sol dont le pieu est encastré
With Range("A3").Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="='Valeurs a,b,c'!$B$2:$G$2"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With
   
' on determine le type et la catégorie du pieu
With Range("B3").Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="='Valeurs a,b,c'!$A$9:$A$28"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With
   
With Range("A3:B3").Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 65535
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
       
' on determine le classe et la catégorie du pieu
Range("C3").FormulaR1C1 = "=VLOOKUP(RC[-1],'Valeurs a,b,c'!R8C1:R28C9,8,FALSE)"
Range("D3").FormulaR1C1 = "=VLOOKUP(RC[-2],'Valeurs a,b,c'!R8C1:R28C9,9,FALSE)"
   
' on prépare la liste déroulante pour le type de sol
With Range("C6").Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="='Valeurs a,b,c'!$B$2:$G$2"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With
   
With Range("C6").Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 65535
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
       
Range("C6").Resize(NbreCouche).FillDown

Range("D6").Resize(NbreCouche, 2).Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 65535
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

Range("A3").Select

  Application.ScreenUpdating = True
End Sub

vgendron · 23 Octobre 2017

Sinon, l'enregistreur de macro, c'est sympa, mais faut quand meme essayer de simplifier et rassembler tout ce qui peut etre rassemblé..

et pourquoi appliquer de nombreuses Mises en forme si elles y sont déjà..?

VB:

Sub Resethypothèse()
Application.ScreenUpdating = False

With Sheets("Hypothèses de Calcul")
    .Activate
    .Range("A3:G3").Clear
    fin = .Range("B" & .Rows.Count).End(xlUp).Row
    .Range("A6").Resize(fin - 5, 5).Clear
   
    With .Range("E3:G3,A6").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
   
'   Cells.Select 'LA mise en forme générale est certainement inutile car jamais effacée
'    Range("A3").Activate
'    With Selection
'        .WrapText = True
'        .Orientation = 0
'        .AddIndent = False
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'        .MergeCells = False
'    End With
'    With Selection
'        .VerticalAlignment = xlCenter
'        .WrapText = True
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'        .MergeCells = False
'    End With
'    With Selection
'        .HorizontalAlignment = xlCenter
'        .VerticalAlignment = xlCenter
'        .WrapText = True
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'        .MergeCells = False
'    End With
   
'    Range("A1:G1").Select
'    With Selection
'        .HorizontalAlignment = xlCenter
'        .VerticalAlignment = xlCenter
'        .WrapText = True
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'        .MergeCells = False
'    End With
'    Selection.Merge
'
'    Range("E3").Select
   
End With


With Sheets("Calcul terme de pointe Rb")
    .Activate
    .Range("A3:M3").Clear
    fin = .Range("B" & .Rows.Count).End(xlUp).Row
    .Range("A6").Resize(fin - 5, 21).Clear
End With
   
'Sheets("Calcul frottement axial qs").Select
With Sheets("Calcul frottement axial qs")
    .Activate
    .Range("A3:F3").Clear
    fin = .Range("B" & .Rows.Count).End(xlUp).Row
    .Range("A6").Resize(fin - 5, 17).Clear
End With
   
'Sheets("Résultats").Select
With Sheets("Résultats")
    .Activate
    .Range("A4:A8").ClearContents
    With .Range("A4:A7,F11:G12,F14:G16,M11:N12,M14:N16").Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
       
'    .Range("A4:A7").Select 'inutile car Mise en Forme non supprimée
'    .Range("A7").Activate
'    With Selection
'        .HorizontalAlignment = xlCenter
'        .VerticalAlignment = xlCenter
'        .WrapText = False
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'        .MergeCells = False
'    End With
'    Selection.Merge
'    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
'    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
'    With Selection.Borders(xlEdgeLeft)
'        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
'        .Weight = xlThin
'    End With
'    With Selection.Borders(xlEdgeTop)
'        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
'        .Weight = xlThin
'    End With
'    With Selection.Borders(xlEdgeBottom)
'        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
'        .Weight = xlThin
'    End With
'    With Selection.Borders(xlEdgeRight)
'        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
'        .Weight = xlThin
'    End With
'    With Selection.Borders(xlInsideVertical)
'        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
'        .Weight = xlThin
'    End With
'    With Selection.Borders(xlInsideHorizontal)
'        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
'        .Weight = xlThin
'    End With
       
    .Range("C26:F27,C29:F31").ClearContents
    With .Range("C26:F27,C29:F31").Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
   
   
    With .Range("E11,E12,E14,E15:E16").Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
   
    With .Range("L11,L12,L14,L15:L16").Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
       
    With .Range("N11,N12,N14,N15:N16").Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    Range("B4:F4,F6,B7:D7,J11:N12,J14:N16,C11:C12,D12,C14:G16,E11:G12").ClearContents
   
'    Cells.Select
'    Range("A4").Activate
'    With Selection
'        .VerticalAlignment = xlBottom
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'    End With
'    With Selection
'        .VerticalAlignment = xlCenter
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'    End With
'    With Selection
'        .HorizontalAlignment = xlGeneral
'        .VerticalAlignment = xlCenter
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'    End With
'    With Selection
'        .HorizontalAlignment = xlCenter
'        .VerticalAlignment = xlCenter
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'    End With
'    With Selection
'        .HorizontalAlignment = xlCenter
'        .VerticalAlignment = xlCenter
'        .WrapText = True
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'    End With
'    Range("A4").Select
'
'    With Selection
'        .HorizontalAlignment = xlCenter
'        .VerticalAlignment = xlCenter
'        .WrapText = True
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'        .MergeCells = True
'    End With
'
   
End With

Sheets("Hypothèses de Calcul").Select
Application.ScreenUpdating = True
End Sub

clyde88 · 24 Octobre 2017

merci beaucoup ton aide l'ami

XL 2013 souci d'affichage des additions

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Nouveau

Discussions similaires

Partager cette page

Statistiques des forums