返回列表 上一主題 發帖

[發問] VBA 中計算數值問題

回復 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

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

  20.     With Range("C5")                '指定楚墫格位置
  21.         .Resize(i, j) = myarray1    '擴充的範圍指定為myarray1的值
  22.     End With
  23. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 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

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

評分人數

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 8# temple

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


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







感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 16# temple
Matrix.xlsx  沒有巨集的Excel 檔
Matrix.xlsm  有巨集的Excel 檔
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 有願放在心裡,沒有身體力行,正如耕田不播種,皆是空過因緣。
返回列表 上一主題