標題: [發問] 設定指定範圍亂數正負0.5內 [打印本頁]

---

作者: jeff5424    時間: 2018-7-28 22:56     標題: 設定指定範圍亂數正負0.5內

本帖最後由 jeff5424 於 2018-7-28 22:59 編輯

使用VBA或巨集進行                                                                                      
1.按"自動載入"會自動載入共15區指定溫度範圍亂數(已完成如下所示)  
2.如第一區需求溫度-10度 溫度正負2度,指定區域C20:V34內溫度範圍亂數(已完成如下所示)  
3.每一個溫度"上下"±0.5內如下所示(左右不用)
   請各位高手大哥協助....謝謝   


以下為Kubi 大大高手設計程式
Sub test()
    Randomize
    Dim arr(1 To 15, 1 To 20)
    v = 20
    For r = 2 To 16
        tpm = Cells(r, 3).Value * 2 + 0.1
        nt = Cells(r, 2).Value - Cells(r, 3).Value
        For i = 1 To UBound(arr)
            For j = 1 To UBound(arr, 2)
                arr(i, j) = nt + Round(Rnd * tpm, 1)
            Next j
        Next i
        Cells(v, 3).Resize(UBound(arr), UBound(arr, 2)) = arr
        v = v + 18
    Next r
End Sub

---

作者: a5007185    時間: 2018-7-29 01:11

回復 1# jeff5424

原先你的陣列是由左至右、由上到下去編輯變數，
我幫你把上到下編輯變數的方式稍微調整一下，
修改成會依據上一個的數值，
做正負0.5的調整，
程式碼如下，
請參考。

1. Sub test()
   
2.     Randomize
   
3.     Dim arr(1 To 15, 1 To 20)
   
4.     v = 20
   
5.     For r = 2 To 16
   
6.         tpm = Cells(r, 3).Value * 2 + 0.1
   
7.         nt = Cells(r, 2).Value - Cells(r, 3).Value
   
8.         For j = 1 To UBound(arr, 2)
   
9.             arr(1, j) = nt + Round(Rnd * tpm, 1)
   
10.             For i = 2 To UBound(arr)
    
11.                 arr(i, j) = arr(i - 1, j) + Round(0.5 - Rnd, 1)
    
12.             Next i
    
13.         Next j
    
14.         Cells(v, 3).Resize(UBound(arr), UBound(arr, 2)) = arr
    
15.         v = v + 18
    
16.     Next r
    
17. End Sub

複製代碼

[attach]29077[/attach]

---

作者: jeff5424    時間: 2018-7-29 10:33

回復 2# a5007185

非常感謝阿佐大大
經測試可正常使用
再一次感謝你的幫忙

---

作者: jeff5424    時間: 2018-8-4 21:51

回復 2# a5007185
阿佐大大
需求溫度正負差2度,但最後溫度正負差部分會超過2度
麻煩再幫我修改程序..謝謝

---

作者: a5007185    時間: 2018-8-5 01:07

回復 4# jeff5424

如果計算出來的結果超過範圍，
他會自己在跑出一個數值。

[attach]29141[/attach]

---

作者: jeff5424    時間: 2018-8-5 09:24

回復 5# a5007185
再次感謝阿佐大大
經測試可正常使用
謝謝你的幫忙

    :loveliness:

---

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