Discussion :

[petitkiwi]

Bonjour à tous,
Voilà je suis un grand débutant sur VBA, et je n'arrive pas à écrire mes instructions, pour un problème simple:
Dans le cadre d'un assemblage cloué (structure bois), avec comme paramètres donnés:
m nombre de ligne de pointes
n nombre de pointes par ligne
a1 espace horizontal entre pointe
a2 espace vertical entre pointe
G centre de gravité de l'assemblage (coordonnées en x : ((n-1)*a1)/2 et coordonnées en y: ((m-1)*a2)/2 )

j'aimerai calculer la somme de toute les distances au carré entre chaque pointe et le centre de gravité G. C'est en réalité un calcul très simple à faire à la main, mais qui peut prendre beaucoup de temps si on arrive à environ 1500 pointes.

Pour la présentation, j'ai penser à un tableau de 4 colonnes par ligne de pointes (n° pointe, coord. X, coord. Y, d² (la dito distance)), avec pour titre de chaque tableau le n° de la ligne.
j'ai joint un shémat au format PDF pour plus de clarté.
Merci pour vos réponse.

[phiiris]

Pourquoi veux-tu faire ce calcul en VBA et non pas via quelques formules arithmétiques, directement dans les cellules ?

La distance entre deux points (x1,y1) et (x2,y2) est égale

Code :

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

((x1-x2)^2+(y1-y2)^2)^0,5

Connaissant les coordonnées de chaque point et du centre de gravité... en mettant x1,y1,x2 et y2 dans une cellule chacun et le calcul dans une cinquième tu devrais avoir la réponse que tu cherches.

Attention : éventuellement tenir compte que l'échelle des absisses peut être différence de celle des ordonnées => intégrer ce facteur dans la fomule.

[petitkiwi]

Oui, c'est vrai, la formule que tu as écrit marche pour une pointe.
C'est ce que je fait actuellement.
Le problème en réalité, c'est que je fait ça à chaque pointe....
Autrement dit, je n'ai pas un assemblages à calculer, mais plusieurs tout les jours!!, et le nombre de pointes est variable entre chaque assemblage, il me faut donc refaire une feuille à chaque fois avec n (variable) pointes.
De plus, pour concevoir un assemblage, ce calcul n'est qu'un parmi beaucoup d'autre, je n'ai pas de temps à perdre: par exemple on essaye avec 30x50 pointes, après 10min de calcul on voit qu'il en faudrait 20% de plus, alors on recommence....jusqu'à optimiser au maximum, on peut refaire ça environ 10 fois pour un assemblage.

[phiiris]

Je t'ai fait une petite macro :

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
Sub Macro1()
Dim x
Dim y
Dim b
Dim gx
Dim gy
Dim Eh
Dim Ev
Eh = Range("b3")
Ev = Range("b4")
gx = Range("b5")
gy = Range("c5")
For x = 0 To Range("b2")
For y = 0 To Range("b1")
b = b + 1
Cells(b + 8, 2) = x
Cells(b + 8, 3) = y
Cells(b + 8, 4) = (((x - gx) * Eh) ^ 2 + ((y - gy) * Ev) ^ 2) ^ 0.5
Next y
Next x
MsgBox ("coucou, c'est fini")
End Sub

et je te joins le fichier.
Dis-moi si ça va.

PS : je ne suis pas trè avancé non plus en VBA, si quelqu'un sur le forum trouve que ce j'ai fait est idiot et qu'il y a mieux, je suis preneur de tous les commentaires.

[petitkiwi]

Super,
C'est exactement ça!!
A vrai dire, j'ai travailler dessus après mon dernier poste (c'est pas bien de faire travailler les autres à sa place )
Ton code est mieux que le mien, je vais donc essayer de le simplifier grâce au tiens.
Néanmoins, même si le plus gros est fait, reste la somme de toute ces valeurs!! et aussi un moyen de réinitialiser la feuille de calcul , je n'ai pas de réponse pour le moment.

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
 
Sub trouver_coordonnées()
 
Dim p As Integer
Dim l As Integer
 
Application.ScreenUpdating = False
 
For l = 0 To Range("b7").Value - 1 Step 1
    Range("a1:d1").Offset(0, 4 * (l + 1)).Activate
    With Selection
        .Merge
        .Value = "ligne" & l + 1
        .HorizontalAlignment = xlCenter
    End With
    Range("a1:d1").Offset(1, 4 * (l + 1)).Activate
    With Selection
        .Value = Array("n°", "dx", "dy", "d²")
    End With
    For p = 0 To Range("b8").Value - 1 Step 1
        Range("a1:d1").Offset(p + 2, 4 * (l + 1)).Activate
        Selection.Value = Array(p + 1, "=" & p & "*B5", "=" & l & "*B6", "=(R10C2-RC[-2])^2+(R11C2-RC[-1])^2")
    Next p
Next l
Application.ScreenUpdating = True
End Sub

[phiiris]

Que veux-tu dire par la somme de toutes ces valeurs ?
S'il s'agit d'en faire l'addition, je suppose que tu y arriveras !
Quant à la réinitialisation, un bouton avec une macro qui efface les données n'est pas difficile à réaliser.

[Pierre Fauconnier]

Bonjour.

Vu que tu demandes la somme des longueurs et non le tableau des longueurs pour en faire la somme, tu peux passer par une fonction personnalisée que tu utiliseras dans Excel en lui passant les paramètres adéquats.

Voici la fonction:

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
Function SommeLongueurs(NombreLignes As Integer, nombrePointes As Integer, EcartLignes As Double, EcartPointes As Double) As Double
  Dim Xg As Double, Yg As Double
  Dim x As Integer, y As Integer
  Dim Somme As Double
 
  Xg = (NombreLignes - 1) * EcartLignes / 2
  Yg = (nombrePointes - 1) * EcartPointes / 2
 
  For x = 0 To NombreLignes - 1
    For y = 0 To nombrePointes - 1
      Somme = Somme + Sqr((Xg - (x * EcartLignes)) ^ 2 + (Yg - (y * EcartPointes)) ^ 2)
    Next y
  Next x
  SommeLongueurs = Somme
End Function

Dans Excel, sur base de ton test1.xlsm, tu utiliseras la fonction

=SommeLongueurs(B7;B8;B5;B6)

PS: Dans l'image de l'équation que tu nous montres, il ne manque pas une racine carrée (pythagore)?