Получить центр тяжести в таблице

Question

У меня есть таблица 5x5 и 25 случайных чисел.Мне нужно рассчитать силу тяжести стола.

Я потратил несколько часов, пытаясь выяснить, как этот код работает, он написан на scala , и я попытался изменить его на VBA, но безуспешно,Вот моя лучшая попытка, которая все еще не верна, вместо того, чтобы генерировать числа, которые я вручную вводил тогда в excel, что мне достаточно.

Таблица Excel

Sub calcGravity()
'get sum
For i = 1 To 5
    For j = 1 To 5
    Sum = Sum + Cells(i, j).Value
    Next j
Next i

For i = 1 To 4
    For j = 1 To 4
    x = x + (i + i) * Cells(i, j).Value / Sum
    y = y + (j + i) * Cells(i, j).Value / Sum
    Next j
Next i
Msgbox("Center :" & x & y)
End Sub

Answer 1

Вот UDF, который может вычислить центр масс:

Function CenterOfGravity(Masses As Variant) As Variant
    'Masses is a 2-dimensional array of weights
    'calculates center of gravity, returning the answer as
    'an array of 2 value

    If TypeName(Masses) = "Range" Then Masses = Masses.Value

    Dim mass As Double
    Dim momentX As Double, momentY As Double
    Dim i As Long, j As Long

    For i = LBound(Masses, 1) To UBound(Masses, 1)
        For j = LBound(Masses, 2) To UBound(Masses, 2)
            mass = mass + Masses(i, j)
            momentX = momentX + j * Masses(i, j)
            momentY = momentY + i * Masses(i, j)
        Next j
    Next i
    CenterOfGravity = Array(momentX / mass, momentY / mass)
End Function

Например:

Ввыше, в ячейках A7: B7 я ввел =CenterOfGravity(A1:E5) в качестве формулы массива (Ctrl+Shift+Enter для принятия).

Answer 2

Незначительные исправления в вашем коде

Option Explicit

Sub calcGravity()
Dim i As Integer, j As Integer
Dim sum As Long
Dim x As double, y As double
'get sum
For i = 1 To 5
    For j = 1 To 5
    sum = sum + Cells(i, j).Value
    'Debug.Print Cells(i, j).Address
    Next j
Next i

For i = 1 To 5
    For j = 1 To 5
    x = x + (i) * Cells(i, j).Value / sum
    y = y + (j) * Cells(i, j).Value / sum
    'Debug.Print Cells(i, j).Address
Next j
Next i
Debug.Print ("Center x: " & x & " y: " & y)
End Sub

Тесты по вышеуказанному коду

Sub Test1()
    Call Set_All_to_0
    Range("A1").Value = 1
    Debug.Print "Only A1 = 1"
    Call calcGravity
    Debug.Print

    Call Set_All_to_0
    Range("E1").Value = 1
    Debug.Print "Only E1 = 1"
    Call calcGravity
    Debug.Print

    Call Set_All_to_0
    Range("A5").Value = 1
    Debug.Print "Only A5 = 1"
    Call calcGravity
    Debug.Print

    Call Set_All_to_0
    Range("E5").Value = 1
    Debug.Print "Only A5 = 1"
    Call calcGravity
    Debug.Print

    Call Set_All_to_0
    Range("A1:E1").Value = 1
    Debug.Print "A1:E1 = 1"
    Call calcGravity
    Debug.Print

    Call Set_All_to_0
    Range("A5:E5").Value = 1
    Debug.Print "A5:E5 = 1"
    Call calcGravity
    Debug.Print

    Call Set_All_to_0
    Range("A1:A5").Value = 1
    Debug.Print "A1:A5 = 1"
    Call calcGravity
    Debug.Print

End Sub

Sub Set_All_to_0()
Dim i As Integer, j As Integer
    For i = 1 To 5
        For j = 1 To 5
            Cells(i, j) = 0
        Next j
    Next i
End Sub

Немедленное окно

Only A1 = 1
Center x: 1 y: 1

Only E1 = 1
Center x: 1 y: 5

Only A5 = 1
Center x: 5 y: 1

Only A5 = 1
Center x: 5 y: 5

Only A1 = 1
Center x: 1 y: 1

Only E1 = 1
Center x: 1 y: 5

Only A5 = 1
Center x: 5 y: 1

Only A5 = 1
Center x: 5 y: 5

Only A1 = 1
Center x: 1 y: 1

Only E1 = 1
Center x: 1 y: 5

Only A5 = 1
Center x: 5 y: 1

Only A5 = 1
Center x: 5 y: 5

A1:E1 = 1
Center x: 1 y: 3

Only A1 = 1
Center x: 1 y: 1

Only E1 = 1
Center x: 1 y: 5

Only A5 = 1
Center x: 5 y: 1

Only A5 = 1
Center x: 5 y: 5

A1:E1 = 1
Center x: 1 y: 3

A1:E1 = 1
Center x: 5 y: 3

Only A1 = 1
Center x: 1 y: 1

Only E1 = 1
Center x: 1 y: 5

Only A5 = 1
Center x: 5 y: 1

Only A5 = 1
Center x: 5 y: 5

A1:E1 = 1
Center x: 1 y: 3

A5:E5 = 1
Center x: 5 y: 3

A1:A5 = 1
Center x: 3 y: 1