Logo GNT
Actualités Tests & Guides Bons Plans
Gemini 3 Shein GTA 6 iPhone 17 Switch 2 ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Aide en language VBA

Aide en language VBA

6 réponses
Avatar
Christian
Bonjour =E0 tous

Je travaille avec un tableau qui reprend des valeurs de=20
points mesur=E9s en coordonn=E9es ( X, Y, Z ).
Ayant sur deux lignes, les coordonn=E9es de d=E9but et fin du=20
m=EAme objet mesur=E9 ; j'ai pu via l'enregistreur de macro=20
=E9tablir le code qui me calcule mes diff=E9rentes mesures,=20
mais pour un objet.
Comment r=E9diger le code qui me permettrait de lancer=20
cette routine pour l'ensemble de mes points (Plusieurs=20
centaines de lignes).

N=B0 X Y Z Distance Horiz.
Distance Oblique.
1001 137,921 35,569 -1,057 zt T1 0,525 0,788
1002 137,917 35,044 -0,469 zt T1 =09
1003 136,505 35,571 -1,041 zt T2 0,532 0,774
1004 136,48 35,04 -0,478 zt T2 =09


Sub DistanceHorizontale()
ActiveCell.FormulaR1C1 =3D "=3DSQRT((R[1]C[-4]-RC[-4])^2+
(R[1]C[-3]-RC[-3])^2)"
ActiveCell.Offset(2, 0).Activate
End Sub

Sub DistanceOblique()
ActiveCell.FormulaR1C1 =3D "=3DSQRT((RC[-1]^2+(R[1]C[-3]-
RC[-3])^2))"
ActiveCell.Offset(2, 0).Activate
End Sub

Merci d'avance.
Christian
Signaler un problème avec ce contenu

6 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
André
Bonjour

En selectionnant la colonne ou tu as tes formules, tu dois
pouvoir recopier corrcetement ces formules vers le bas en
faisant Contr+B et avoit tes calculs immédiatement

André
-----Message d'origine-----
Bonjour à tous

Je travaille avec un tableau qui reprend des valeurs de
points mesurés en coordonnées ( X, Y, Z ).
Ayant sur deux lignes, les coordonnées de début et fin du
même objet mesuré ; j'ai pu via l'enregistreur de macro
établir le code qui me calcule mes différentes mesures,
mais pour un objet.
Comment rédiger le code qui me permettrait de lancer
cette routine pour l'ensemble de mes points (Plusieurs
centaines de lignes).

N° X Y Z Distance Horiz.
Distance Oblique.
1001 137,921 35,569 -1,057 zt T1 0,525 0,788
1002 137,917 35,044 -0,469 zt T1
1003 136,505 35,571 -1,041 zt T2 0,532 0,774
1004 136,48 35,04 -0,478 zt T2


Sub DistanceHorizontale()
ActiveCell.FormulaR1C1 = "=SQRT((R[1]C[-4]-RC[-4])^2+
(R[1]C[-3]-RC[-3])^2)"
ActiveCell.Offset(2, 0).Activate
End Sub

Sub DistanceOblique()
ActiveCell.FormulaR1C1 = "=SQRT((RC[-1]^2+(R[1]C[-3]-
RC[-3])^2))"
ActiveCell.Offset(2, 0).Activate
End Sub

Merci d'avance.
Christian

.



Avatar
Christian
Bonjour André
Cela n'est pas possible, il y a une cellule vide en
dessous a respecter; coordonnées de l'objet sur deux
lignes.
Merci tout de même
Bonne journée

-----Message d'origine-----
Bonjour

En selectionnant la colonne ou tu as tes formules, tu
dois

pouvoir recopier corrcetement ces formules vers le bas
en

faisant Contr+B et avoit tes calculs immédiatement

André
-----Message d'origine-----
Bonjour à tous

Je travaille avec un tableau qui reprend des valeurs de
points mesurés en coordonnées ( X, Y, Z ).
Ayant sur deux lignes, les coordonnées de début et fin
du


même objet mesuré ; j'ai pu via l'enregistreur de macro
établir le code qui me calcule mes différentes mesures,
mais pour un objet.
Comment rédiger le code qui me permettrait de lancer
cette routine pour l'ensemble de mes points (Plusieurs
centaines de lignes).

N° X Y Z Distance Horiz.
Distance Oblique.
1001 137,921 35,569 -1,057 zt T1 0,525 0,788
1002 137,917 35,044 -0,469 zt T1
1003 136,505 35,571 -1,041 zt T2 0,532 0,774
1004 136,48 35,04 -0,478 zt T2


Sub DistanceHorizontale()
ActiveCell.FormulaR1C1 = "=SQRT((R[1]C[-4]-RC[-4])
^2+


(R[1]C[-3]-RC[-3])^2)"
ActiveCell.Offset(2, 0).Activate
End Sub

Sub DistanceOblique()
ActiveCell.FormulaR1C1 = "=SQRT((RC[-1]^2+(R[1]C[-
3]-


RC[-3])^2))"
ActiveCell.Offset(2, 0).Activate
End Sub

Merci d'avance.
Christian

.

.





Avatar
jym
"Christian" a écrit dans le message de
news:026b01c397ae$c8b49f50$
Bonjour André
Cela n'est pas possible, il y a une cellule vide en
dessous a respecter; coordonnées de l'objet sur deux
lignes.
Merci tout de même
Bonne journée

sélectionner la cellulle de calcul et la cellule du dessous
puis recopier vers le bas


sinon
calcul du nombre de ligne
nbligne=range("").end(xldown).row
et une boucle
for i=1 to nbligne step 2
le calcul , utilisation de offset pour le positionnement
next i



.

.





Avatar
Christian
Merci Jym
Je vais essayer cela tout de suite.
Bonne APM
Christian
-----Message d'origine-----

"Christian" a
écrit dans le message de

news:026b01c397ae$c8b49f50$
Bonjour André
Cela n'est pas possible, il y a une cellule vide en
dessous a respecter; coordonnées de l'objet sur deux
lignes.
Merci tout de même
Bonne journée

sélectionner la cellulle de calcul et la cellule du
dessous

puis recopier vers le bas


sinon
calcul du nombre de ligne
nbligne=range("").end(xldown).row
et une boucle
for i=1 to nbligne step 2
le calcul , utilisation de offset pour le positionnement
next i



.

.





.





Avatar
Modeste
Bonjour,
partant du code original, il y a tres peu de
modifications :
l'astuce ici consiste simplement en fait à recopier vers
le bas
une zone avec formules(F2:G2) et une zone sans formule
(F3:G3)
soit la zone f2:G3

' Macro enregistrée par GeeDee
Sub Macro2()
nblignes = Range("A1").CurrentRegion.Rows.Count
Range("F2").Select
ActiveCell.FormulaR1C1 = _
"=SQRT((R[1]C[-4]-RC[-4])^2+(R[1]C[-3]-RC[-3])^2)"
Range("G2").Select
ActiveCell.FormulaR1C1 = _
"=SQRT((R[1]C[-4]-RC[-4])^2+(R[1]C[-3]-RC[-3])^2)"
Range("F2:G3").Select
Selection.AutoFill Destination:=Range(Cells(2, 6),
Cells(nblignes, 7))

End Sub

@+

-----Message d'origine-----
Bonjour à tous

Je travaille avec un tableau qui reprend des valeurs de
points mesurés en coordonnées ( X, Y, Z ).
Ayant sur deux lignes, les coordonnées de début et fin du
même objet mesuré ; j'ai pu via l'enregistreur de macro
établir le code qui me calcule mes différentes mesures,
mais pour un objet.
Comment rédiger le code qui me permettrait de lancer
cette routine pour l'ensemble de mes points (Plusieurs
centaines de lignes).

N° X Y Z Distance Horiz.
Distance Oblique.
1001 137,921 35,569 -1,057 zt T1 0,525 0,788
1002 137,917 35,044 -0,469 zt T1
1003 136,505 35,571 -1,041 zt T2 0,532 0,774
1004 136,48 35,04 -0,478 zt T2


Sub DistanceHorizontale()
ActiveCell.FormulaR1C1 = "=SQRT((R[1]C[-4]-RC[-4])^2+
(R[1]C[-3]-RC[-3])^2)"
ActiveCell.Offset(2, 0).Activate
End Sub

Sub DistanceOblique()
ActiveCell.FormulaR1C1 = "=SQRT((RC[-1]^2+(R[1]C[-3]-
RC[-3])^2))"
ActiveCell.Offset(2, 0).Activate
End Sub

Merci d'avance.
Christian

.



Avatar
Christian
Merci GeeDee
Cela fonctionne merveilleusement
Christian
-----Message d'origine-----
Bonjour,
partant du code original, il y a tres peu de
modifications :
l'astuce ici consiste simplement en fait à recopier vers
le bas
une zone avec formules(F2:G2) et une zone sans formule
(F3:G3)
soit la zone f2:G3

' Macro enregistrée par GeeDee
Sub Macro2()
nblignes = Range("A1").CurrentRegion.Rows.Count
Range("F2").Select
ActiveCell.FormulaR1C1 = _
"=SQRT((R[1]C[-4]-RC[-4])^2+(R[1]C[-3]-RC[-3])
^2)"

Range("G2").Select
ActiveCell.FormulaR1C1 = _
"=SQRT((R[1]C[-4]-RC[-4])^2+(R[1]C[-3]-RC[-3])
^2)"

Range("F2:G3").Select
Selection.AutoFill Destination:=Range(Cells(2, 6),
Cells(nblignes, 7))

End Sub

@+

-----Message d'origine-----
Bonjour à tous

Je travaille avec un tableau qui reprend des valeurs de
points mesurés en coordonnées ( X, Y, Z ).
Ayant sur deux lignes, les coordonnées de début et fin
du


même objet mesuré ; j'ai pu via l'enregistreur de macro
établir le code qui me calcule mes différentes mesures,
mais pour un objet.
Comment rédiger le code qui me permettrait de lancer
cette routine pour l'ensemble de mes points (Plusieurs
centaines de lignes).

N° X Y Z Distance Horiz.
Distance Oblique.
1001 137,921 35,569 -1,057 zt T1 0,525 0,788
1002 137,917 35,044 -0,469 zt T1
1003 136,505 35,571 -1,041 zt T2 0,532 0,774
1004 136,48 35,04 -0,478 zt T2


Sub DistanceHorizontale()
ActiveCell.FormulaR1C1 = "=SQRT((R[1]C[-4]-RC[-4])
^2+


(R[1]C[-3]-RC[-3])^2)"
ActiveCell.Offset(2, 0).Activate
End Sub

Sub DistanceOblique()
ActiveCell.FormulaR1C1 = "=SQRT((RC[-1]^2+(R[1]C[-
3]-


RC[-3])^2))"
ActiveCell.Offset(2, 0).Activate
End Sub

Merci d'avance.
Christian

.

.