Board logo

標題: [發問] VBA 中計算數值問題 [打印本頁]
作者: temple    時間: 2015-2-26 02:39     標題: 詢問矩陣設計問題

我寫了一個 4*4 的矩陣, 矩陣值會有分數, 但執行後 < 0 的部份都顯示 0
如果才能讓它顯示分數?

語法:
Dim myarray1(2 To 5, 2 To 5) As Integer

myarray1(2, 2) = 1
myarray1(2, 3) = 1
myarray1(2, 4) = 3
myarray1(2, 5) = 5

myarray1(3, 2) = 1
myarray1(3, 3) = 1
myarray1(3, 4) = 2
myarray1(3, 5) = 4

myarray1(4, 2) = 1 / 3
myarray1(4, 3) = 1 / 3
myarray1(4, 4) = 1
myarray1(4, 5) = 5

myarray1(5, 2) = 1 / 5
myarray1(5, 3) = 1 / 4
myarray1(5, 4) = 1 / 5
myarray1(5, 5) = 1

For i = 2 To 5
  For j = 2 To 5
    Cells(i, j).Value = myarray1(i, j)
    Next j
Next i

End Sub
作者: HUNGCHILIN    時間: 2015-2-26 13:48

1.將定義改成 Dim myarray1(2 To 5, 2 To 5) As Single 就可以
2.儲存格 格式改成 分數格式
作者: temple    時間: 2015-2-27 17:19

問題已解決   非常謝謝你
作者: temple    時間: 2015-2-27 18:23     標題: [發問] VBA 中計算數值問題

我設計了一個 3*3 的矩陣, 想做 row 的乘法,
例如, myarray1(2,2) 的 1 * myarray1(3, 2) = 1 *myarray1(4, 2) = 1 / 3
即 1*1*3

這個語法要怎麼寫?

Dim myarray1(2 To 4, 2 To 4) As Single

myarray1(2, 2) = 1
myarray1(2, 3) = 1
myarray1(2, 4) = 3

myarray1(3, 2) = 1
myarray1(3, 3) = 1
myarray1(3, 4) = 2

myarray1(4, 2) = 1 / 3
myarray1(4, 3) = 1 / 2
myarray1(4, 4) = 1


For i = 2 To 4
  For j = 2 To 4
    Cells(i, j).Value = myarray1(i, j)
    Next j
Next i

End Sub
作者: GBKEE    時間: 2015-3-1 07:56

回復 4# temple

是這樣嗎?
  1. Option Explicit
  2. Sub Ex()
  3.     Dim myarray1(2 To 4, 2 To 4) As Single
  4.     Dim i As Integer, j As Integer
  5.     i = UBound(myarray1, 1)
  6.     i = i - LBound(myarray1, 1) + 1 '第一維的元素數
  7.     j = UBound(myarray1, 2)
  8.     j = j - LBound(myarray1, 2) + 1 '第二維的元素數
  9.    
  10.     myarray1(2, 2) = 1
  11.     myarray1(2, 3) = 1
  12.     myarray1(2, 4) = 3
  13.    
  14.     myarray1(3, 2) = 1
  15.     myarray1(3, 3) = 1
  16.     myarray1(3, 4) = 2

  18.     myarray1(4, 2) = 1 / 3
  19.     myarray1(4, 3) = 1 / 2
  20.     myarray1(4, 4) = 1

  22.     With Range("C5")                '指定楚墫格位置
  23.         .Resize(i, j) = myarray1    '擴充的範圍指定為myarray1的值
  24.     End With
  25. End Sub
複製代碼
作者: temple    時間: 2015-3-1 16:27

先謝謝超級版主的建議, 我是想在矩陣中再加一個欄位, 可以自動做 row的計算, 像下面那個矩陣一樣
1.............1........3.........(1*1*3)
1.............1....... 2........(1*1*3)
1/3.....1/2.......1........(1/3*1/2*1)
作者: GBKEE    時間: 2015-3-1 21:16

回復 6# temple
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim myarray1(2 To 4, 2 To 4) As Single
  4.     Dim AR As Variant
  5.     Dim i As Integer, j As Integer
  6.    
  7.     myarray1(2, 2) = 10
  8.     myarray1(2, 3) = 10
  9.     myarray1(2, 4) = 3
  10.    
  11.     myarray1(3, 2) = 5
  12.     myarray1(3, 3) = 17
  13.     myarray1(3, 4) = 2

  15.     myarray1(4, 2) = 1 / 3
  16.     myarray1(4, 3) = 1 / 2
  17.     myarray1(4, 4) = 1
  18.    
  19.     AR = myarray1
  20.     ReDim Preserve AR(LBound(myarray1) To UBound(myarray1), LBound(myarray1, 2) To UBound(myarray1, 2) + 1)
  21.    
  22.     For i = LBound(AR) To UBound(AR)
  23.         AR(i, UBound(AR, 2)) = Application.Product(Application.WorksheetFunction.Index(myarray1, i - LBound(AR) + 1))
  24.     Next
  25.    
  26.     i = UBound(AR, 1)
  27.     i = i - LBound(AR, 1) + 1 '第一維的元素數
  28.     j = UBound(AR, 2)
  29.     j = j - LBound(AR, 2) + 1 '第二維的元素數
  30.    
  31.     With ActiveSheet.Range("C5")     '指定楚墫格位置
  32.         .Resize(i, j) = AR      '擴充的範圍指定為Ar的值
  33.     End With
  34. End Sub
複製代碼
作者: temple    時間: 2015-3-4 16:00

想再詢問超級版主，若我再加入一個欄位，從 3*3 變 4*4, 應該怎麼修改語法？(看了好久, 不太了解 ReDim 這句語法)

1.............1........3.......2........(1*1*3*2)
1.............1....... 2......1.........(1*1*3*1)
1/3.....1/2.......1.......3........(1/3*1/2*1*3)
作者: GBKEE    時間: 2015-3-5 09:17

回復 8# temple

ReDim 陳述式在程序層次中用來重新配置動態陣列變數的儲存空間。
語法
ReDim [Preserve] varname(subscripts) [As type] [, varname(subscripts) [As type]] . . .
Preserve 選擇性引數。當改變原有陣列最後一維的大小時，仍然保有原來的資料的關鍵字。


  2. Option Explicit
  3. Sub EX()
  4.     Dim AR()
  5.     AR = [A1:F2].Value '-> AR(1 To 2, 1 To 6)
  6.    
  7.     ReDim Preserve AR(1 To 2, 1 To 7)
  8. End Sub
複製代碼


[attach]20371[/attach]




[attach]20372[/attach]
作者: temple    時間: 2015-3-5 14:12

謝謝你 --- 我會再練習看看, 有問題再麻煩你囉~~
作者: temple    時間: 2015-5-28 18:37

我想請問超級版主, 如果用VBA語法, 如何判斷矩陣中的任一數值被改變, 並且能夠讓它重新計算1.............1........3.......2........(1*1*3*2)
1.............1....... 2......1.........(1*1*3*1)
1/3.....1/2.......1.......3........(1/3*1/2*1*3)
再麻煩您~~
作者: GBKEE    時間: 2015-5-29 07:01

回復 11# temple
  1. '**************'工作表上數值的變動*************************
  2. Option Explicit
  3. Private Sub Worksheet_Change(ByVal Target As Range)
  4.     Application.EnableEvents = False
  5.     If Not Intersect(Range("a1:e3"), Target.Cells(1)) Is Nothing Then
  6.         '數值的改變在 "a1:e3" 的範圍中
  7.         Ex_工作表上的重算
  8.     End If
  9.     Application.EnableEvents = False
  10. End Sub
  11. Sub Ex_工作表上的重算()
  12.     Dim myarray1(), ar(), i As Integer
  13.     With Range("a1:d3")
  14.         For i = 1 To .Rows.Count
  15.             Rows(i).Cells(1, "E") = Application.Product(.Rows(i))
  16.         Next
  17.     End With
  18. End Sub
  19. '*************'陣列數值改變 *******************************
  20. Option Explicit
  21. Dim Ar_Key As String, myarray1()
  22. Sub Ex()
  23.     Dim i As Integer, S As String
  24.     myarray1() = Range("a1:d3").Value   '陣列數值
  25.     For i = 1 To UBound(myarray1)
  26.         S = S & Join(Application.Index(myarray1, i), ",") & ","
  27.     Next
  28.     If S <> Ar_Key Then  '比對陣列數值
  29.         Ex_重算
  30.         Ex_陣列紀錄
  31.     End If
  32. End Sub
  33. Sub Ex_重算()
  34.     Dim myarray1(), ar(), i As Integer
  35.     myarray1() = Range("a1:d3").Value
  36.    
  37.     ReDim ar(1 To UBound(myarray1))
  38.     For i = 1 To UBound(ar)
  39.         ar(i) = Application.Product(Application.Index(myarray1, i))
  40.     Next
  41.     Range("e1:e3") = Application.WorksheetFunction.Transpose(ar)
  42. End Sub
  43. Private Sub Ex_陣列紀錄()  '
  44.     Dim i As Integer
  45.     myarray1() = Range("a1:d3").Value
  46.     Ar_Key = ""
  47.     For i = 1 To UBound(myarray1)
  48.         Ar_Key = Ar_Key & Join(Application.Index(myarray1, i), ",") & ","
  49.         '陣列資料紀錄下來
  50.     Next
  51. End Sub
複製代碼
作者: temple    時間: 2015-5-29 22:33

超級版主, 真的是太感謝你了!!!
作者: temple    時間: 2015-6-21 12:09

超級版主您好,

因為我的權限有限, 無法將程式檔案附加上來, 也無法傳短消息給您, 我仍然有矩陣計算問題想請教您, 不曉得應該怎麼處理, 方便給我您的 email? 或是有其它方式? 麻煩您
作者: temple    時間: 2015-6-21 15:28

超級版主您好,
我的問題是: 變更數值時, 沒有辦法進行重算, 不曉得是哪裡出了問題
[attach]21227[/attach]
作者: temple    時間: 2015-6-21 15:53

超級版主您好, 我發現檔案中的語法好像沒有被儲存起來,所以用pdf 檔把語法複製下,再請您幫我看看,
[attach]21228[/attach]
作者: GBKEE    時間: 2015-6-21 16:07

回復 16# temple
Matrix.xlsx  沒有巨集的Excel 檔
Matrix.xlsm  有巨集的Excel 檔
作者: temple    時間: 2015-6-21 17:17

超級版主您好, 我選"excel活頁簿" 或"啟用巨集的活頁簿", 都無法儲存語法, 不知道為什麼?  只能附上 pdf檔給您
作者: temple    時間: 2015-6-22 09:55

超級版主您好,之前可能是我在存檔時步驟上有問題, 或是自己粗心, 今天又試了一次存 .xlsm 就有儲存到語法, 可是, 在更改元素後仍然無法重算, 不曉得是不是事件沒有建立的緣因, 請超級版主指點[attach]21229[/attach]
作者: GBKEE    時間: 2015-6-23 15:41

回復 19# temple
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Application.EnableEvents = False  '停止觸發事件
  3.     If Not Intersect(Range("b2:e5"), Target.Cells(1)) Is Nothing Then
  4.         '數值的改變在 "a1:e3" 的範圍中
  5.         Ex_工作表上的重算
  6.     End If
  7.     Application.EnableEvents = True    '要會回復能觸發事件
  8.     'Application.EnableEvents = False  '這裡錯誤
  9.    
  10. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)