[發問] 請問如何使用VBA計算方陣

linlin00

我想請問有一個例題，已經將兩兩的中心求出，
例如:n筆資料(A,B)
第一筆資料(5,5)
第二筆資料(6,6)
先計算得1跟2的中心為(5.5  ,  5.5)
而在矩陣上對照1跟2的計算公式為 (第一筆資料A-(12的A平均))^2+(第二筆資料A-(12的A平均))^2+(第一筆資料B-(12的B平均))^2+(第二筆資料B-(12的B平均))^2
不是很會敘述，不知道這樣有沒有比較清楚
附件內是我用手打的方陣，因為花的時間比較長，想請問能否用VBA縮短時間
方陣.rar (8.64 KB)

下載次數: 8

2015-7-28 18:01

linlin00

回復 14# lpk187
好的,沒關係,非常感謝!!

lpk187

回復 13# linlin00

不好意思！還是不懂！可能要請其他大大出手相助了

linlin00

合併.rar (9.54 KB)

下載次數: 5

2015-7-30 00:56

回復 11# lpk187
前面跟原本都相同以編號1跟2舉例，計算得到在這個方陣範圍中最小的是1，想要傳回這個1是(1,2)以及(3,4)的組合
之後是以前面得到的結果合併(1,2)，計算一張新的方陣
如附件工作表二內，先將(1,2)合起來後，計算(1,2),3就變成
(編號1.2.3分別-(1,2,3)的平均數)^2的總和
不知道這樣有沒有比較清楚

linlin00

回復 11# lpk187
好的，我先整理一下我手算的部分

lpk187

回復 10# linlin00


   不好意思！不是很懂你的意思。我對算數方面不是很熟！如果有公式或結果，倒可以試一下！

linlin00

回復 2# lpk187

我目前使用這一個來操作，想請問如果要找方陣範圍內的最小值並回傳是哪兩個的組合，有辦法做到嗎?
下一步想要將這一個最小值的兩組做結合，接著算新的一個方陣

linlin00

回復 8# lpk187
謝謝，這個速度變很快，而且也能得到我想要的結果，不過多了好多我不懂的東西還需要花點時間吸收.....

lpk187

回復 6# linlin00

不知是不是你想要的
其實只是把它以陣列的方式去跑(陣列比在儲存格跑快很多)

1. Public Sub Ex1()
   
2. Dim ar1(), ar2()
   
3. n = 1
   
4. arr = Range("a2:c" & Cells(Rows.Count, 1).End(xlUp).Row) '當ABC三欄往下增加資料時會自動讀取位置
   
5. ReDim ar2(1 To UBound(arr) + 1, 1 To UBound(arr) + 1)
   
6. ar2(1, 2) = 1
   
7. For i = 1 To UBound(arr) - 1
   
8.     ar2(1, i + 2) = i + 1
   
9.     X = i + 1
   
10.     For j = X To UBound(arr)
    
11.         ReDim Preserve ar1(1 To 3, 1 To n)
    
12.         ar1(1, n) = arr(i, 1) & "," & arr(j, 1)
    
13.         ar1(2, n) = (arr(i, 2) + arr(j, 2)) / 2
    
14.         ar1(3, n) = (arr(i, 3) + arr(j, 3)) / 2
    
15.         ar2(j, 1) = j - 1
    
16.         ar2(j + 1, i + 1) = (arr(i, 2) - ar1(2, n)) ^ 2 _
    
17.                       + (arr(j, 2) - ar1(2, n)) ^ 2 _
    
18.                       + (arr(i, 3) - ar1(3, n)) ^ 2 _
    
19.                       + (arr(j, 3) - ar1(3, n)) ^ 2
    
20.         n = n + 1
    
21.     Next
    
22. Next
    
23. ar2(j, 1) = i
    
24. Range("F2").Resize(UBound(ar1, 2), UBound(ar1, 1)) = Application.Transpose(ar1)
    
25. Range("J1").Resize(UBound(ar2, 2), UBound(ar2, 1)) = ar2
    
26. End Sub

複製代碼

linlin00

回復 5# linlin00

更正，K的部分問題已經解決了!