- 帖子
- 552
- 主題
- 6
- 精華
- 0
- 積分
- 576
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2015-2-8
- 最後登錄
- 2026-9-10
  
|
回復 6# linlin00
不知是不是你想要的
其實只是把它以陣列的方式去跑(陣列比在儲存格跑快很多)- Public Sub Ex1()
- Dim ar1(), ar2()
- n = 1
- arr = Range("a2:c" & Cells(Rows.Count, 1).End(xlUp).Row) '當ABC三欄往下增加資料時會自動讀取位置
- ReDim ar2(1 To UBound(arr) + 1, 1 To UBound(arr) + 1)
- ar2(1, 2) = 1
- For i = 1 To UBound(arr) - 1
- ar2(1, i + 2) = i + 1
- X = i + 1
- For j = X To UBound(arr)
- ReDim Preserve ar1(1 To 3, 1 To n)
- ar1(1, n) = arr(i, 1) & "," & arr(j, 1)
- ar1(2, n) = (arr(i, 2) + arr(j, 2)) / 2
- ar1(3, n) = (arr(i, 3) + arr(j, 3)) / 2
- ar2(j, 1) = j - 1
- ar2(j + 1, i + 1) = (arr(i, 2) - ar1(2, n)) ^ 2 _
- + (arr(j, 2) - ar1(2, n)) ^ 2 _
- + (arr(i, 3) - ar1(3, n)) ^ 2 _
- + (arr(j, 3) - ar1(3, n)) ^ 2
- n = n + 1
- Next
- Next
- ar2(j, 1) = i
- Range("F2").Resize(UBound(ar1, 2), UBound(ar1, 1)) = Application.Transpose(ar1)
- Range("J1").Resize(UBound(ar2, 2), UBound(ar2, 1)) = ar2
- End Sub
|
|
發表於 2015-7-28 20:40
| 
