12
返回列表 上一主題 發帖

VBA 類神經運算 求助

qwertyuio111

帖子
11 
主題
1 
精華
0 
積分
20 
點名
0  
作業系統
mac 
軟體版本
OX 10.1.1 
閱讀權限
10 
註冊時間
2015-11-20 
最後登錄
2016-1-7 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-11-20 10:24 | 只看該作者

VBA 類神經運算 求助

本帖最後由 qwertyuio111 於 2015-11-20 10:26 編輯

各位 高手 您好
小弟最近在學校，初學Excel ＶＢＡ使用在類神經的運算模擬上。
此類神經模擬是以 「5 x 8 x 5 x 2 」的方式進行，輸入5個已知值，再透過兩個隱藏層（8,5）運算，求得2個目標值輸出。
透過已知的數據（輸入值，目標值），因此會求得 90個 模擬循環產生之新Ｗ。

此程式碼 運作一開始是以 產生一組亂數Ｗ 之後固定，再輸入值及目標值後，透過運算 迴圈公式 求得模擬後的新Ｗ。
發現迴圈程式碼過與冗長，經查資料發現使用「陣列運算」或許可行，但始終無法正確的寫出來。
尚且重複性的在資料表中，「輸入及讀取 儲存格的值」，造成迴圈運算的緩慢，及暫存記憶體的不足形成當機。
求助各位高手 能否幫助及教導小弟 解決這方面的問題。

在此奉上 Excel 資料表 求助 謝謝 （因無法直接上傳 excel檔案 所以利用 google 雲端）

Excel 類神經運算模擬檔案
收藏 分享

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 2015-11-20 14:31 | 只看該作者
回復 1# qwertyuio111
為什麼你的W要設計成9X10的陣列
而不是 5x8、8x5、5x2，三個陣列
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

qwertyuio111

帖子
11 
主題
1 
精華
0 
積分
20 
點名
0  
作業系統
mac 
軟體版本
OX 10.1.1 
閱讀權限
10 
註冊時間
2015-11-20 
最後登錄
2016-1-7 
3#
發表於 2015-11-20 22:28 | 只看該作者
回復 2# stillfish00


    啊啊，是應該那樣子做才對嗎？
當初因為想到會透過前一個隱藏層的「誤差值」，重新運算 新的Ｗ產生。
所以沒有考慮到把陣列拆開運算的過程。

那我應該要怎麼做才正確呢？

是不是應該把 迴圈拆成 三個部分來寫 這樣比較妥當？

我想解決 重複 讀取 及 輸入 在儲存格上的步驟，因為會造成運算上的緩慢...
先 謝謝大大 指導

TOP

qwertyuio111

帖子
11 
主題
1 
精華
0 
積分
20 
點名
0  
作業系統
mac 
軟體版本
OX 10.1.1 
閱讀權限
10 
註冊時間
2015-11-20 
最後登錄
2016-1-7 
4#
發表於 2015-11-21 19:29 | 只看該作者

迴圈運算程式碼 記憶體釋放（求解）

本帖最後由 qwertyuio111 於 2015-11-21 19:31 編輯

大家好 我有個迴圈模擬運算的問題
會有自行輸入運算次數（Worksheets("Sheet1").Range("J9")）
因為重複 「讀取」及「輸入」數值的過程，造成記憶體不足。
請問 要增加哪個程式碼或改成怎麼樣的寫法會比較好呢？
才能夠解決 記憶體不足的問題呀？
以下為部分程式碼
  1. For i = 2 To Worksheets("Sheet1").Range("J9")
  2. intA = Worksheets("Sheet1").Range("B1")
  3. intB = Worksheets("Sheet1").Range("B2")
  4. intc = Worksheets("Sheet1").Range("B3")
  5. intD = Worksheets("Sheet1").Range("B4")
  6. intE = Worksheets("Sheet1").Range("B5")
  7. tarn = Worksheets("Sheet1").Range("L6")
  8. taro = Worksheets("Sheet1").Range("L7")

  10. neww1 = Worksheets("Sheet1").Range("A24")
  11. neww2 = Worksheets("Sheet1").Range("A25")
  12. neww3 = Worksheets("Sheet1").Range("A26")
  13. neww4 = Worksheets("Sheet1").Range("A27")
  14. neww5 = Worksheets("Sheet1").Range("A28")
  15. neww6 = Worksheets("Sheet1").Range("A29")
  16. neww7 = Worksheets("Sheet1").Range("A30")
  17. neww8 = Worksheets("Sheet1").Range("A31")
  18. neww9 = Worksheets("Sheet1").Range("A32")

  20. neww10 = Worksheets("Sheet1").Range("B24")
  21. neww11 = Worksheets("Sheet1").Range("B25")
  22. neww12 = Worksheets("Sheet1").Range("B26")
  23. neww13 = Worksheets("Sheet1").Range("B27")
  24. neww14 = Worksheets("Sheet1").Range("B28")
  25. neww15 = Worksheets("Sheet1").Range("B29")
  26. neww16 = Worksheets("Sheet1").Range("B30")
  27. neww17 = Worksheets("Sheet1").Range("B31")
  28. neww18 = Worksheets("Sheet1").Range("B32")

  30. neww19 = Worksheets("Sheet1").Range("C24")
  31. neww20 = Worksheets("Sheet1").Range("C25")
  32. neww21 = Worksheets("Sheet1").Range("C26")
  33. neww22 = Worksheets("Sheet1").Range("C27")
  34. neww23 = Worksheets("Sheet1").Range("C28")
  35. neww24 = Worksheets("Sheet1").Range("C29")
  36. neww25 = Worksheets("Sheet1").Range("C30")
  37. neww26 = Worksheets("Sheet1").Range("C31")
  38. neww27 = Worksheets("Sheet1").Range("C32")

  40. neww28 = Worksheets("Sheet1").Range("D24")
  41. neww29 = Worksheets("Sheet1").Range("D25")
  42. neww30 = Worksheets("Sheet1").Range("D26")
  43. neww31 = Worksheets("Sheet1").Range("D27")
  44. neww32 = Worksheets("Sheet1").Range("D28")
  45. neww33 = Worksheets("Sheet1").Range("D29")
  46. neww34 = Worksheets("Sheet1").Range("D30")
  47. neww35 = Worksheets("Sheet1").Range("D31")
  48. neww36 = Worksheets("Sheet1").Range("D32")

  50. neww37 = Worksheets("Sheet1").Range("E24")
  51. neww38 = Worksheets("Sheet1").Range("E25")
  52. neww39 = Worksheets("Sheet1").Range("E26")
  53. neww40 = Worksheets("Sheet1").Range("E27")
  54. neww41 = Worksheets("Sheet1").Range("E28")
  55. neww42 = Worksheets("Sheet1").Range("E29")
  56. neww43 = Worksheets("Sheet1").Range("E30")
  57. neww44 = Worksheets("Sheet1").Range("E31")
  58. neww45 = Worksheets("Sheet1").Range("E32")

  60. neww46 = Worksheets("Sheet1").Range("F24")
  61. neww47 = Worksheets("Sheet1").Range("F25")
  62. neww48 = Worksheets("Sheet1").Range("F26")
  63. neww49 = Worksheets("Sheet1").Range("F27")
  64. neww50 = Worksheets("Sheet1").Range("F28")
  65. neww51 = Worksheets("Sheet1").Range("F29")
  66. neww52 = Worksheets("Sheet1").Range("F30")
  67. neww53 = Worksheets("Sheet1").Range("F31")
  68. neww54 = Worksheets("Sheet1").Range("F32")

  70. neww55 = Worksheets("Sheet1").Range("G24")
  71. neww56 = Worksheets("Sheet1").Range("G25")
  72. neww57 = Worksheets("Sheet1").Range("G26")
  73. neww58 = Worksheets("Sheet1").Range("G27")
  74. neww59 = Worksheets("Sheet1").Range("G28")
  75. neww60 = Worksheets("Sheet1").Range("G29")
  76. neww61 = Worksheets("Sheet1").Range("G30")
  77. neww62 = Worksheets("Sheet1").Range("G31")
  78. neww63 = Worksheets("Sheet1").Range("G32")

  80. neww64 = Worksheets("Sheet1").Range("H24")
  81. neww65 = Worksheets("Sheet1").Range("H25")
  82. neww66 = Worksheets("Sheet1").Range("H26")
  83. neww67 = Worksheets("Sheet1").Range("H27")
  84. neww68 = Worksheets("Sheet1").Range("H28")
  85. neww69 = Worksheets("Sheet1").Range("H29")
  86. neww70 = Worksheets("Sheet1").Range("H30")
  87. neww71 = Worksheets("Sheet1").Range("H31")
  88. neww72 = Worksheets("Sheet1").Range("H32")

  90. neww73 = Worksheets("Sheet1").Range("I24")
  91. neww74 = Worksheets("Sheet1").Range("I25")
  92. neww75 = Worksheets("Sheet1").Range("I26")
  93. neww76 = Worksheets("Sheet1").Range("I27")
  94. neww77 = Worksheets("Sheet1").Range("I28")
  95. neww78 = Worksheets("Sheet1").Range("I29")
  96. neww79 = Worksheets("Sheet1").Range("I30")
  97. neww80 = Worksheets("Sheet1").Range("I31")
  98. neww81 = Worksheets("Sheet1").Range("I32")

  100. neww82 = Worksheets("Sheet1").Range("J24")
  101. neww83 = Worksheets("Sheet1").Range("J25")
  102. neww84 = Worksheets("Sheet1").Range("J26")
  103. neww85 = Worksheets("Sheet1").Range("J27")
  104. neww86 = Worksheets("Sheet1").Range("J28")
  105. neww87 = Worksheets("Sheet1").Range("J29")
  106. neww88 = Worksheets("Sheet1").Range("J30")
  107. neww89 = Worksheets("Sheet1").Range("J31")
  108. neww90 = Worksheets("Sheet1").Range("J32")

  110. inta1 = (intA * neww1) + (intB * neww9) + (intc * neww17) + (intD * neww25) + (intE * neww33)
  111. outa1 = 1 / (1 + Exp(-inta1))

  113. intb1 = (intA * neww2) + (intB * neww10) + (intc * neww18) + (intD * neww26) + (intE * neww34)
  114. outb1 = 1 / (1 + Exp(-intb1))

  116. intc1 = (intA * neww3) + (intB * neww11) + (intc * neww19) + (intD * neww27) + (intE * neww35)
  117. outc1 = 1 / (1 + Exp(-intc1))

  119. intd1 = (intA * neww4) + (intB * neww12) + (intc * neww20) + (intD * neww28) + (intE * neww36)
  120. outd1 = 1 / (1 + Exp(-intd1))

  122. inte1 = (intA * neww5) + (intB * neww13) + (intc * neww21) + (intD * neww29) + (intE * neww37)
  123. oute1 = 1 / (1 + Exp(-inte1))

  125. intf1 = (intA * neww6) + (intB * neww14) + (intc * neww22) + (intD * neww30) + (intE * neww38)
  126. outf1 = 1 / (1 + Exp(-intf1))

  128. intg1 = (intA * neww7) + (intB * neww15) + (intc * neww23) + (intD * neww31) + (intE * neww39)
  129. outg1 = 1 / (1 + Exp(-intg1))

  131. inth1 = (intA * neww8) + (intB * neww16) + (intc * neww24) + (intD * neww32) + (intE * neww40)
  132. outh1 = 1 / (1 + Exp(-inth1))

  134. Worksheets("Sheet1").Range("D1") = inta1
  135. Worksheets("Sheet1").Range("F1") = outa1
  136. Worksheets("Sheet1").Range("D2") = intb1
  137. Worksheets("Sheet1").Range("F2") = outb1
  138. Worksheets("Sheet1").Range("D3") = intc1
  139. Worksheets("Sheet1").Range("F3") = outc1
  140. Worksheets("Sheet1").Range("D4") = intd1
  141. Worksheets("Sheet1").Range("F4") = outd1
  142. Worksheets("Sheet1").Range("D5") = inte1
  143. Worksheets("Sheet1").Range("F5") = oute1
  144. Worksheets("Sheet1").Range("D6") = intf1
  145. Worksheets("Sheet1").Range("F6") = outf1
  146. Worksheets("Sheet1").Range("D7") = intg1
  147. Worksheets("Sheet1").Range("F7") = outg1
  148. Worksheets("Sheet1").Range("D8") = inth1
  149. Worksheets("Sheet1").Range("F8") = outh1

  151. inti1 = (outa1 * neww41) + (outb1 * neww46) + (outc1 * neww51) + (outd1 * neww56) + (oute1 * neww61) + (outf1 * neww66) + (outg1 * neww71) + (outh1 * neww76)
  152. outi1 = 1 / (1 + Exp(-inti1))

  154. intj1 = (outa1 * neww42) + (outb1 * neww47) + (outc1 * neww52) + (outd1 * neww57) + (oute1 * neww62) + (outf1 * neww67) + (outg1 * neww72) + (outh1 * neww77)
  155. outj1 = 1 / (1 + Exp(-intj1))

  157. intk1 = (outa1 * neww43) + (outb1 * neww48) + (outc1 * neww53) + (outd1 * neww58) + (oute1 * neww63) + (outf1 * neww68) + (outg1 * neww73) + (outh1 * neww78)
  158. outk1 = 1 / (1 + Exp(-intk1))

  160. intl1 = (outa1 * neww44) + (outb1 * neww49) + (outc1 * neww54) + (outd1 * neww59) + (oute1 * neww64) + (outf1 * neww69) + (outg1 * neww74) + (outh1 * neww79)
  161. outl1 = 1 / (1 + Exp(-intl1))

  163. intm1 = (outa1 * neww45) + (outb1 * neww50) + (outc1 * neww55) + (outd1 * neww60) + (oute1 * neww65) + (outf1 * neww70) + (outg1 * neww75) + (outh1 * neww80)
  164. outm1 = 1 / (1 + Exp(-intm1))

  166. Worksheets("Sheet1").Range("H1") = inti1
  167. Worksheets("Sheet1").Range("J1") = outi1
  168. Worksheets("Sheet1").Range("H2") = intj1
  169. Worksheets("Sheet1").Range("J2") = outj1
  170. Worksheets("Sheet1").Range("H3") = intk1
  171. Worksheets("Sheet1").Range("J3") = outk1
  172. Worksheets("Sheet1").Range("H4") = intl1
  173. Worksheets("Sheet1").Range("J4") = outl1
  174. Worksheets("Sheet1").Range("H5") = intm1
  175. Worksheets("Sheet1").Range("J5") = outm1

  177. intn1 = (outi1 * neww81) + (outj1 * neww83) + (outk1 * neww85) + (outl1 * neww87) + (outm1 * neww89)
  178. outn1 = 1 / (1 + Exp(-intn1))

  180. into1 = (outi1 * neww82) + (outj1 * neww84) + (outk1 * neww86) + (outl1 * neww88) + (outm1 * neww90)
  181. outo1 = 1 / (1 + Exp(-into1))

  183. Worksheets("Sheet1").Range("L1") = intn1
  184. Worksheets("Sheet1").Range("N1") = outn1
  185. Worksheets("Sheet1").Range("L2") = into1
  186. Worksheets("Sheet1").Range("N2") = outo1

  188. errn = outn1 * (1 - outn1) * (tarn - outn1)
  189. erro = outo1 * (1 - outo1) * (taro - outo1)

  191. Worksheets("Sheet1").Range("N5") = errn
  192. Worksheets("Sheet1").Range("N6") = erro

  194. neww81 = neww81 + (errn * outi1)
  195. neww82 = neww82 + (erro * outi1)
  196. neww83 = neww83 + (errn * outj1)
  197. neww84 = neww84 + (erro * outj1)
  198. neww85 = neww85 + (errn * outk1)
  199. neww86 = neww86 + (erro * outk1)
  200. neww87 = neww87 + (errn * outl1)
  201. neww88 = neww88 + (erro * outl1)
  202. neww89 = neww89 + (errn * outm1)
  203. neww90 = neww90 + (erro * outm1)

  205. erri = outi1 * (1 - outi1) * (errn * neww81 + erro * neww82)
  206. errj = outj1 * (1 - outj1) * (errn * neww83 + erro * neww84)
  207. errk = outk1 * (1 - outk1) * (errn * neww85 + erro * neww86)
  208. errl = outl1 * (1 - outl1) * (errn * neww87 + erro * neww88)
  209. errm = outm1 * (1 - outm1) * (errn * neww89 + erro * neww90)

  211. Worksheets("Sheet1").Range("P5") = erri
  212. Worksheets("Sheet1").Range("P6") = errj
  213. Worksheets("Sheet1").Range("P7") = errk
  214. Worksheets("Sheet1").Range("P8") = errl
  215. Worksheets("Sheet1").Range("P9") = errm

  217. neww41 = neww41 + (erri * outa1)
  218. neww42 = neww42 + (errj * outa1)
  219. neww43 = neww43 + (errk * outa1)
  220. neww44 = neww44 + (errl * outa1)
  221. neww45 = neww45 + (errm * outa1)
  222. neww46 = neww46 + (erri * outb1)
  223. neww47 = neww47 + (errj * outb1)
  224. neww48 = neww48 + (errk * outb1)
  225. neww49 = neww49 + (errl * outb1)
複製代碼

TOP

qwertyuio111

帖子
11 
主題
1 
精華
0 
積分
20 
點名
0  
作業系統
mac 
軟體版本
OX 10.1.1 
閱讀權限
10 
註冊時間
2015-11-20 
最後登錄
2016-1-7 
5#
發表於 2015-11-22 09:33 | 只看該作者
回復 4# qwertyuio111

版主 GBKEE
  小弟 我已附上Excel 壓縮檔案
求解 ＱＡＱ∼∼謝謝

類神經擴充 迴圈運算.zip (56.13 KB)

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2015-11-23 07:00 | 只看該作者
回復 5# qwertyuio111
可否詳說, 類神經運算 公式的規律邏輯.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

qwertyuio111

帖子
11 
主題
1 
精華
0 
積分
20 
點名
0  
作業系統
mac 
軟體版本
OX 10.1.1 
閱讀權限
10 
註冊時間
2015-11-20 
最後登錄
2016-1-7 
7#
發表於 2015-11-23 13:03 | 只看該作者
回復 6# GBKEE


    類神經網路 是一種模擬運算的邏輯，藉由模擬運算及訓練的過程找到可能解的產生。

如圖所示


然而在訓練的過程，必透過已知的資料(輸入層的數值以及輸出層之目標值)重覆運算誤差值，去求出隱藏層所佔的比重。


運算式的長短會因為層數及 輸入數目的不同而有所改變。
目的是找出經過許多已知資料所模擬出最佳w。再獲得新的資料時，輸入後透過運算(w)求得最佳的outpot輸出
附上圖片例題的運算excel
類神經例題(迴圈運算).zip (133.49 KB)

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2015-11-24 08:34 | 只看該作者
回復 7# qwertyuio111


修改你的程式碼 試試看
  1. Option Explicit  '在模組層次中強迫每個在模組裏的變數都必須明確的宣告
  2. Sub test()
  3.     Dim Sh As Worksheet, w(), i As Integer
  4.     Dim out As Single, ina1 As Single, inb1 As Single, ina2 As Single, outa2 As Single
  5.     Dim inc As Single, outc As Single, oute As Single, oute1 As Single, oute2 As Single
  6.     Dim inb2 As Single, outb2 As Single
  7.     Set Sh = Sheets("Sheet1")
  8.     out = Sh.Cells(1, 2)
  9.     ina1 = Sh.Cells(3, 2)
  10.     inb1 = Sh.Cells(5, 2)
  11.     w = Application.WorksheetFunction.Transpose(Sh.Range("b7").Resize(6))
  12.    
  13.     ina2 = (ina1 * w(3)) + (inb1 * w(4))
  14.     outa2 = 1 / (1 + Exp(-ina2))
  15.     inb2 = (ina1 * w(5)) + (inb1 * w(6))
  16.     outb2 = 1 / (1 + Exp(-inb2))
  17.     inc = (outa2 * w(1)) + (outb2 * w(2))
  18.     outc = 1 / (1 + Exp(-inc))
  19.     oute = (out - outc) * (1 - outc) * (outc)
  20.     w(1) = w(1) + (oute * outa2)
  21.     w(2) = w(2) + (oute * outb2)
  22.     oute1 = oute * w(1) * (1 - outa2) * outa2
  23.     oute2 = oute * w(2) * (1 - outb2) * outb2
  24.     w(3) = w(3) + (oute1 * ina1)
  25.     w(4) = w(4) + (oute1 * inb1)
  26.     w(5) = w(5) + (oute2 * ina1)
  27.     w(6) = w(6) + (oute2 * inb1)
  28. '***********************************************
  29.     For i = 2 To 300
  30.         ina2 = (ina1 * w(3)) + (inb1 * w(4))
  31.         outa2 = 1 / (1 + Exp(-ina2))
  32.         inb2 = (ina1 * w(5)) + (inb1 * w(6))
  33.         outb2 = 1 / (1 + Exp(-inb2))
  34.         inc = (outa2 * w(1)) + (outb2 * w(2))
  35.         outc = 1 / (1 + Exp(-inc))
  36.         oute = (out - outc) * (1 - outc) * (outc)
  37.         w(1) = w(1) + (oute * outa2)
  38.         w(2) = w(2) + (oute * outb2)
  39.         oute1 = oute * w(1) * (1 - outa2) * outa2
  40.         oute2 = oute * w(2) * (1 - outb2) * outb2
  41.         w(3) = w(3) + (oute1 * ina1)
  42.         w(4) = w(4) + (oute1 * inb1)
  43.         w(5) = w(5) + (oute2 * ina1)
  44.         w(6) = w(6) + (oute2 * inb1)
  45.     Next
  46.     ''''''''''''''''''''''''''''
  47.     With Sh
  48.         .Cells(14, 2) = ina2
  49.         .Cells(15, 2) = outa2
  50.         .Cells(17, 2) = inb2
  51.         .Cells(18, 2) = outb2
  52.         .Cells(20, 2) = inc
  53.         .Cells(21, 2) = outc
  54.         '''''''''''''''''''''''''''''
  55.         .Cells(23, 2) = oute
  56.         .Cells(25, 2) = w(1)
  57.         .Cells(26, 2) = w(2)
  58.         ''''''''''''''''''''''''
  59.         .Cells(29, 2) = oute1
  60.         .Cells(30, 2) = oute2
  61.         ''''''''''''''''''''
  62.         .Cells(32, 2) = w(3)
  63.         .Cells(33, 2) = w(4)
  64.         .Cells(34, 2) = w(5)
  65.         .Cells(35, 2) = w(6)
  66.     End With
  67. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
9#
發表於 2015-11-24 10:20 | 只看該作者
本帖最後由 c_c_lai 於 2015-11-24 11:32 編輯

回復 7# qwertyuio111
試試看 (依據你的程式碼修改)：
  1. Sub 類神經運算()
  2.     Dim lowerRange, upperRange, myRange, myCell As Range, cts As Integer, nxt As Integer
  3.     Dim rp5 As Integer, bf1 As Integer
  4.    
  5.     With Sheets("Sheet1")
  6.         Set lowerRange = .Range("C11")
  7.         Set upperRange = .Range("C10")
  8.         lowerRange.Name = "lowerbound"
  9.         upperRange.Name = "upperbound"
  10.         Set myRange = .Range("A13:J21")

  12.         For Each myCell In myRange
  13.             myCell.Formula = "=RANDBETWEEN(lowerbound,upperbound)/10"
  14.         Next
  15.    
  16.        .[A23] = "循環Ｗ"
  17.            
  18.        For cts = 0 To 7     '  inta1 = (intA * w1) + (intB * w9) + (intc * w17) + (intD * w25) + (intE * w33)
  19.            .[D1].Offset(cts) = (.[B1] * .[A13].Offset(cts)) + (.[B2] * IIf(cts = 0, .[A21], .[B12].Offset(cts))) + (.[B3] * IIf(cts <= 1, .[B20], .[C11].Offset(cts)) + (.[B4] * IIf(cts <= 2, .[C19], .[D10].Offset(cts)))) + (.[B5] * IIf(cts <= 3, .[D18], .[E9].Offset(cts)))
  20.            .[F1].Offset(cts) = 1 / (1 + Exp(-.[D1].Offset(cts)))   '  outa1 = 1 / (1 + Exp(-inta1))
  21.        Next cts

  23.        For cts = 0 To 4     '  inti1 = (outa1 * w41) + (outb1 * w46) + (outc1 * w51) + (outd1 * w56) + (oute1 * w61) + (outf1 * w66) + (outg1 * w71) + (outh1 * w76)
  24.            .[H1].Offset(cts) = (.[F1] * .[E17].Offset(cts)) + (.[F2] * .[F13].Offset(cts)) + (.[F3] * IIf(cts = 4, .[G13], .[F18].Offset(cts))) + (.[F4] * .[G14].Offset(cts)) + (.[F5] * IIf(cts > 2, .[H10].Offset(cts), .[G19].Offset(cts))) + (.[F6] * .[H15].Offset(cts)) + (.[F7] * IIf(cts > 1, .[I11].Offset(cts), .[H20].Offset(cts))) + (.[F8] * .[I16].Offset(cts))
  25.            .[J1].Offset(cts) = 1 / (1 + Exp(-.[H1].Offset(cts)))     '  outi1 = 1 / (1 + Exp(-inti1))
  26.        Next cts
  27.    
  28.        For cts = 0 To 1     '  intn1 = (outi1 * w81) + (outj1 * w83) + (outk1 * w85) + (outl1 * w87) + (outm1 * w89)
  29.            .[L1].Offset(cts) = (.[J1] * IIf(cts = 0, .[I21], .[J13])) + (.[J2] * .[J14].Offset(cts)) + (.[J3] * .[J16].Offset(cts)) + (.[J4] * .[J18].Offset(cts)) + (.[J5] * .[J20].Offset(cts))
  30.            .[N1].Offset(cts) = 1 / (1 + Exp(-.[L1].Offset(cts)))     '  outn1 = 1 / (1 + Exp(-intn1))
  31.        Next cts
  32.       
  33.        For cts = 0 To 1     '  errn = outn1 * (1 - outn1) * (tarn - outn1) ,   erro = outo1 * (1 - outo1) * (taro - outo1)
  34.            .[N5].Offset(cts) = .[N1].Offset(cts) * (1 - .[N1].Offset(cts)) * (.[L6].Offset(cts) - .[N1].Offset(cts))
  35.        Next cts
  36.       
  37.        For cts = 0 To 4     '  erri = outi1 * (1 - outi1) * (errn * w81 + erro * w82)   ~   errm = outm1 * (1 - outm1) * (errn * w89 + erro * w90)
  38.            .[P5].Offset(cts) = .[J1].Offset(cts) * (1 - .[J1].Offset(cts)) * (.[N5] * IIf(cts = 0, .[I21], .[J9].Offset(cts * 2 + 1))) + (.[N6] * .[J11].Offset(cts * 2 + 2))
  39.        Next cts
  40.       
  41.        For cts = 0 To 7     '  erra = outa1 * (1 - outa1) * (erri * w41 + errj * w42 + errk * w43 + errl * w44 + errm * w45)
  42.             .Range("Z1:Z5").Clear    '  清除傳存運算資料欄之內容值
  43.             
  44.             If (cts = 7) Then       '  7
  45.                .[Z1] = .[I16]
  46.                .[Z2] = .[I17]
  47.             ElseIf (cts > 4) Then   '  5,6
  48.                .[Z1] = .[H15].Offset((cts - 5) * 5)
  49.                .[Z2] = .[H16].Offset((cts - 5) * 5)
  50.             ElseIf (cts > 2) Then   '  3,4
  51.                .[Z1] = .[G14].Offset((cts - 3) * 5)
  52.                .[Z2] = .[G15].Offset((cts - 3) * 5)
  53.             ElseIf (cts = 0) Then   '  0
  54.                .[Z1] = .[E17]
  55.                .[Z2] = .[E18]
  56.                .[Z3] = .[E19]
  57.             Else                    '  1,2
  58.                .[Z1] = .[F13].Offset((cts - 1) * 5)
  59.                .[Z2] = .[F14].Offset((cts - 1) * 5)
  60.             End If

  62.             If (cts > 5) Then       '  6,7
  63.                .[Z3] = .[I13].Offset((cts - 6) * 5)
  64.                .[Z4] = .[I14].Offset((cts - 6) * 5)
  65.                .[Z5] = .[I15].Offset((cts - 6) * 5)
  66.             ElseIf (cts = 5) Then   '  5
  67.                .[Z3] = .[H17]
  68.                .[Z4] = .[H13].Offset((cts - 5) * 5)
  69.                .[Z5] = .[H14].Offset((cts - 5) * 5)
  70.             ElseIf (cts > 3) Then    '  4
  71.                .[Z3] = .[G16].Offset((cts - 4) * 5)
  72.                .[Z4] = .[H13].Offset((cts - 4) * 5)
  73.                .[Z5] = .[H14].Offset((cts - 4) * 5)
  74.             ElseIf (cts = 3) Then    '  3
  75.                .[Z3] = .[G16].Offset((cts - 3) * 5)
  76.                .[Z4] = .[G15]
  77.                .[Z5] = .[H14].Offset((cts - 3) * 5)
  78.             ElseIf (cts > 1) Then    '  2
  79.                .[Z3] = .[F15].Offset((cts - 2) * 5)
  80.                .[Z4] = .[F16].Offset((cts - 2) * 5)
  81.                .[Z5] = .[G13].Offset((cts - 2) * 5)
  82.             ElseIf (cts = 0) Then    '  0
  83.                .[Z3] = .[E19]
  84.                .[Z4] = .[E20]
  85.                .[Z5] = .[E21]
  86.             Else                      '  1
  87.                .[Z3] = .[F15].Offset((cts - 1) * 5)
  88.                .[Z4] = .[F16].Offset((cts - 1) * 5)
  89.                .[Z5] = .[F17]
  90.             End If
  91.             
  92.             
  93.             .[R5].Offset(cts) = .[F1].Offset(cts) * (1 - .[F1].Offset(cts)) * (.[P5] * .[Z1] + .[P6] * .[Z2] + .[P7] * .[Z3] + .[P8] * .[Z4] + .[P9] * .[Z5])
  94.             '  檢驗測試結果
  95.             '  .[V10].Offset(cts) = .[Z1]
  96.             '  .[V10].Offset(cts, 1) = .[Z2]
  97.             '  .[V10].Offset(cts, 2) = .[Z3]
  98.             '  .[V10].Offset(cts, 3) = .[Z4]
  99.             '  .[V10].Offset(cts, 4) = .[Z5]
  100.        Next cts
  101.    
  102.        .Range("Z1:Z5").Clear         '  清除傳存運算資料欄之內容值
  103.        '  .Range("V10:Z17").Clear    '  清除傳存運算資料欄之內容值

  105.        rp5 = -1: bf1 = 0
  106.        For nxt = 0 To 9         '  neww1 = w1 + (erra * intA)   ~  neww54 = w54 + (errl * outc1)
  107.            For cts = 0 To 8
  108.                rp5 = rp5 + 1

  110.                If ((nxt * 9 + cts + 1) > 80) Then          '  neww81 = w81 + (errn * outi1) ~ neww90 = w90 + (erro * outm1)
  111.                    If ((nxt * 9 + cts + 1) = 81) Then
  112.                        rp5 = 0
  113.                        bf1 = 0
  114.                    End If
  115.                   
  116.                    .[A24].Offset(cts, nxt) = .[A13].Offset(cts) + (.[N5].Offset(rp5) * .[J1].Offset(bf1))
  117.                   
  118.                    If (rp5 = 1) Then
  119.                        rp5 = -1
  120.                        bf1 = bf1 + 1
  121.                    End If
  122.                ElseIf ((nxt * 9 + cts + 1) > 40) Then      '  neww41 = w41 + (erri * outa1) ~ neww80 = w80 + (errm * outh1)
  123.                    If ((nxt * 9 + cts + 1) = 41) Then
  124.                        rp5 = 0
  125.                        bf1 = 0
  126.                    End If
  127.                   
  128.                    .[A24].Offset(cts, nxt) = .[A13].Offset(cts) + (.[P5].Offset(rp5) * .[F1].Offset(bf1))
  129.                   
  130.                    If (rp5 = 4) Then
  131.                        rp5 = -1
  132.                        bf1 = bf1 + 1
  133.                    End If
  134.                Else                                        '  neww1 = w1 + (erra * intA) ~ neww40 = w40 + (errh * intE)
  135.                    .[A24].Offset(cts, nxt) = .[A13].Offset(cts) + (.[R5].Offset(rp5) * .[B1].Offset(bf1))
  136.                   
  137.                    If (rp5 = 7) Then
  138.                        rp5 = -1
  139.                        bf1 = bf1 + 1
  140.                    End If
  141.                End If
  142.            Next cts
  143.        Next nxt
  144.    End With
  145.   類神經擴充迴圈運算
  146. End Sub
複製代碼

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
10#
發表於 2015-11-24 11:03 | 只看該作者
回復 7# qwertyuio111
  1. Sub 類神經擴充迴圈運算()
  2.     Dim cts As Integer, nxt As Integer
  3.     Dim rp5 As Integer, bf1 As Integer, i As Integer
  4.    
  5.     With Sheets("Sheet1")
  6.        For i = 2 To 150    ' 1500
  7.            .[A23] = "循環Ｗ (" & i & ")"
  8.            For cts = 0 To 7     '  inta1 = (intA * neww1) + (intB * neww9) + (intc * neww17) + (intD * neww25) + (intE * neww33)
  9.                .[D1].Offset(cts) = (.[B1] * .[A24].Offset(cts)) + (.[B2] * IIf(cts = 0, .[A32], .[B23].Offset(cts))) + (.[B3] * IIf(cts <= 1, .[B31], .[C22].Offset(cts)) + (.[B4] * IIf(cts <= 2, .[C30], .[D21].Offset(cts)))) + (.[B5] * IIf(cts <= 3, .[D29], .[E20].Offset(cts)))
  10.                .[F1].Offset(cts) = 1 / (1 + Exp(-.[D1].Offset(cts)))   '  outa1 = 1 / (1 + Exp(-inta1))
  11.            Next cts

  13.            For cts = 0 To 4     '  inti1 = (outa1 * neww41) + (outb1 * neww46) + (outc1 * neww51) + (outd1 * neww56) + (oute1 * neww61) + (outf1 * neww66) + (outg1 * neww71) + (outh1 * neww76)
  14.            .[H1].Offset(cts) = (.[F1] * .[E28].Offset(cts)) + (.[F2] * .[F24].Offset(cts)) + (.[F3] * IIf(cts = 4, .[G24], .[F29].Offset(cts))) + (.[F4] * .[G25].Offset(cts)) + (.[F5] * IIf(cts > 2, .[H21].Offset(cts), .[G30].Offset(cts))) + (.[F6] * .[H26].Offset(cts)) + (.[F7] * IIf(cts > 1, .[I22].Offset(cts), .[H31].Offset(cts))) + (.[F8] * .[I27].Offset(cts))
  15.                .[J1].Offset(cts) = 1 / (1 + Exp(-.[H1].Offset(cts)))     '  outi1 = 1 / (1 + Exp(-inti1))
  16.            Next cts
  17.    
  18.            For cts = 0 To 1     '  intn1 = (outi1 * neww81) + (outj1 * neww83) + (outk1 * neww85) + (outl1 * neww87) + (outm1 * neww89)
  19.                .[L1].Offset(cts) = (.[J1] * IIf(cts = 0, .[I32], .[J24])) + (.[J2] * .[J25].Offset(cts)) + (.[J3] * .[J27].Offset(cts)) + (.[J4] * .[J29].Offset(cts)) + (.[J5] * .[J31].Offset(cts))
  20.                .[N1].Offset(cts) = 1 / (1 + Exp(-.[L1].Offset(cts)))     '  outn1 = 1 / (1 + Exp(-intn1))
  21.            Next cts
  22.       
  23.            For cts = 0 To 1     '  errn = outn1 * (1 - outn1) * (tarn - outn1) ,   erro = outo1 * (1 - outo1) * (taro - outo1)
  24.                .[N5].Offset(cts) = .[N1].Offset(cts) * (1 - .[N1].Offset(cts)) * (.[L6].Offset(cts) - .[N1].Offset(cts))
  25.            Next cts
  26.       
  27.            For cts = 0 To 4     '  erri = outi1 * (1 - outi1) * (errn * neww81 + erro * neww82)   ~   errm = outm1 * (1 - outm1) * (errn * neww89 + erro * neww90)
  28.                .[P5].Offset(cts) = .[J1].Offset(cts) * (1 - .[J1].Offset(cts)) * (.[N5] * IIf(cts = 0, .[I32], .[J20].Offset(cts * 2 + 1))) + (.[N6] * .[J22].Offset(cts * 2 + 2))
  29.            Next cts
  30.       
  31.            For cts = 0 To 7     '  erra = outa1 * (1 - outa1) * (erri * w41 + errj * w42 + errk * w43 + errl * w44 + errm * w45)
  32.                 .Range("Z1:Z5").Clear    '  清除傳存運算資料欄之內容值
  33.             
  34.                 If (cts = 7) Then       '  7
  35.                    .[Z1] = .[I27]
  36.                    .[Z2] = .[I28]
  37.                 ElseIf (cts > 4) Then   '  5,6
  38.                    .[Z1] = .[H26].Offset((cts - 5) * 5)
  39.                    .[Z2] = .[H27].Offset((cts - 5) * 5)
  40.                 ElseIf (cts > 2) Then   '  3,4
  41.                    .[Z1] = .[G25].Offset((cts - 3) * 5)
  42.                    .[Z2] = .[G26].Offset((cts - 3) * 5)
  43.                 ElseIf (cts = 0) Then   '  0
  44.                    .[Z1] = .[E28]
  45.                    .[Z2] = .[E29]
  46.                    .[Z3] = .[E30]
  47.                 Else                    '  1,2
  48.                    .[Z1] = .[F24].Offset((cts - 1) * 5)
  49.                    .[Z2] = .[F25].Offset((cts - 1) * 5)
  50.                 End If

  52.                 If (cts > 5) Then       '  6,7
  53.                    .[Z3] = .[I24].Offset((cts - 6) * 5)
  54.                    .[Z4] = .[I25].Offset((cts - 6) * 5)
  55.                    .[Z5] = .[I26].Offset((cts - 6) * 5)
  56.                 ElseIf (cts = 5) Then   '  5
  57.                    .[Z3] = .[H28]
  58.                    .[Z4] = .[H24].Offset((cts - 5) * 5)
  59.                    .[Z5] = .[H25].Offset((cts - 5) * 5)
  60.                 ElseIf (cts > 3) Then    '  4
  61.                    .[Z3] = .[G27].Offset((cts - 4) * 5)
  62.                    .[Z4] = .[H24].Offset((cts - 4) * 5)
  63.                    .[Z5] = .[H25].Offset((cts - 4) * 5)
  64.                 ElseIf (cts = 3) Then    '  3
  65.                    .[Z3] = .[G27].Offset((cts - 3) * 5)
  66.                    .[Z4] = .[G26]
  67.                    .[Z5] = .[H25].Offset((cts - 3) * 5)
  68.                 ElseIf (cts > 1) Then    '  2
  69.                    .[Z3] = .[F26].Offset((cts - 2) * 5)
  70.                    .[Z4] = .[F27].Offset((cts - 2) * 5)
  71.                    .[Z5] = .[G24].Offset((cts - 2) * 5)
  72.                 ElseIf (cts = 0) Then    '  0
  73.                    .[Z3] = .[E30]
  74.                    .[Z4] = .[E31]
  75.                    .[Z5] = .[E32]
  76.                 Else                      '  1
  77.                    .[Z3] = .[F26].Offset((cts - 1) * 5)
  78.                    .[Z4] = .[F27].Offset((cts - 1) * 5)
  79.                    .[Z5] = .[F28]
  80.                 End If
  81.             
  82.             
  83.                 .[R5].Offset(cts) = .[F1].Offset(cts) * (1 - .[F1].Offset(cts)) * (.[P5] * .[Z1] + .[P6] * .[Z2] + .[P7] * .[Z3] + .[P8] * .[Z4] + .[P9] * .[Z5])
  84.                 '  檢驗測試結果
  85.                 '  .[V10].Offset(cts) = .[Z1]
  86.                 '  .[V10].Offset(cts, 1) = .[Z2]
  87.                 '  .[V10].Offset(cts, 2) = .[Z3]
  88.                 '  .[V10].Offset(cts, 3) = .[Z4]
  89.                 '  .[V10].Offset(cts, 4) = .[Z5]
  90.            Next cts
  91.    
  92.            .Range("Z1:Z5").Clear         '  清除傳存運算資料欄之內容值
  93.            '  .Range("V10:Z17").Clear    '  清除傳存運算資料欄之內容值

  95.            rp5 = -1: bf1 = 0
  96.            For nxt = 0 To 9         '  neww1 = neww1 + (erra * intA)   ~  neww54 = neww54 + (errl * outc1)
  97.                For cts = 0 To 8
  98.                    rp5 = rp5 + 1

  100.                    If ((nxt * 9 + cts + 1) > 80) Then          '  neww81 = neww81 + (errn * outi1) ~ neww90 = neww90 + (erro * outm1)
  101.                        If ((nxt * 9 + cts + 1) = 81) Then
  102.                            rp5 = 0
  103.                            bf1 = 0
  104.                        End If
  105.                   
  106.                        .[A24].Offset(cts, nxt) = .[A24].Offset(cts, nxt) + (.[N5].Offset(rp5) * .[J1].Offset(bf1))
  107.                   
  108.                        If (rp5 = 1) Then
  109.                            rp5 = -1
  110.                            bf1 = bf1 + 1
  111.                        End If
  112.                    ElseIf ((nxt * 9 + cts + 1) > 40) Then      '  neww41 = neww41 + (erri * outa1) ~ neww80 = neww80 + (errm * outh1)
  113.                        If ((nxt * 9 + cts + 1) = 41) Then
  114.                            rp5 = 0
  115.                            bf1 = 0
  116.                        End If
  117.                   
  118.                        .[A24].Offset(cts, nxt) = .[A24].Offset(cts, nxt) + (.[P5].Offset(rp5) * .[F1].Offset(bf1))
  119.                   
  120.                        If (rp5 = 4) Then
  121.                            rp5 = -1
  122.                            bf1 = bf1 + 1
  123.                        End If
  124.                    Else                                        '  neww1 = neww1 + (erra * intA) ~ neww40 = neww40 + (errh * intE)
  125.                        .[A24].Offset(cts, nxt) = .[A24].Offset(cts, nxt) + (.[R5].Offset(rp5) * .[B1].Offset(bf1))
  126.                        
  127.                        If (rp5 = 7) Then
  128.                            rp5 = -1
  129.                            bf1 = bf1 + 1
  130.                        End If
  131.                    End If
  132.                Next cts
  133.            Next nxt
  134.        Next i
  135.    End With
  136. End Sub
複製代碼

TOP

        靜思自在 : 小事不做、大事難成。
12
返回列表 上一主題