請協助優化excel vba usb

有朋自遠方來

wsj 2019-12-07 21:56:47 ‧ 1810 瀏覽

分享至

我寫了一個usb,但是一直run很久沒有執行完成,想向各位大大詢問是否哪裡出了問題,是否可以幫忙建議如何優化,感恩!

Sub wsj()
Application.EnableEvents = False
Application.Interactive = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Dim i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, k, s, t, u As Integer
k = 1
With Worksheets("工作表1")
For i1 = 0 To 1
    .Range("p3") = i1
  For i2 = 0 To 1
      .Range("q3") = i2
      For i3 = 0 To 1
         .Range("r3") = i3
         For i4 = 0 To 1
             .Range("s3") = i4
             For i5 = 0 To 1
                 .Range("t3") = i5
                  For i6 = 0 To 1
                      .Range("u3") = i6
                       For i7 = 0 To 1
                           .Range("v3") = i7
                           For i8 = 0 To 1
                               .Range("w3") = i8
                               For i9 = 0 To 1
                                   .Range("x3") = i9
                                   For i10 = 0 To 1
                                       .Range("y3") = i10
                                       s = .Range("m53")
                                       t = .Range("n53")
                                       u = .Range("o3")
If Application.WorksheetFunction.Sum(Range("i1:i10")) > 5 And Application.WorksheetFunction.Sum(Range("i1:i10")) < 10 Then
       k = k + 1
      .Range("aa" & (k)).Value = i1
      .Range("ab" & (k)).Value = i2
      .Range("ac" & (k)).Value = i3
      .Range("ad" & (k)).Value = i4
      .Range("ae" & (k)).Value = i5
      .Range("af" & (k)).Value = i6
      .Range("ag" & (k)).Value = i7
      .Range("ah" & (k)).Value = i8
      .Range("ai" & (k)).Value = i9
      .Range("aj" & (k)).Value = i10
      .Range("ak" & (k)).Value = s
      .Range("al" & (k)).Value = t
      .Range("bm" & (k)).Value = u 
End If
                                   Next i10
                               Next i9
                            Next i8
                        Next i7
                    Next i6
                Next i5
            Next i4
       Next i3
   Next i2
Next i1
End With
Application.EnableEvents = True
Application.Interactive = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub

看更多先前的討論...收起先前的討論...

paicheng0111 iT邦大師 5 級 ‧ 2019-12-08 12:22:26 檢舉

請去前一個問題，選出最佳解答。

ckp6250 iT邦好手 1 級 ‧ 2019-12-08 14:05:38 檢舉

縮排！縮排！請縮排！
您不縮排！我就不來！

wsj iT邦新手 5 級 ‧ 2019-12-09 14:04:53 檢舉

抱歉我縮排了,但是貼上去就沒有縮排,這個誰能教我一下?

paicheng0111 iT邦大師 5 級 ‧ 2019-12-09 16:26:08 檢舉

在編輯框中，按alt+ctrl+c，會出現上下兩個```。
把程式碼貼在```與```之間，即可順利顯示縮排了。

wsj iT邦新手 5 級 ‧ 2019-12-09 20:15:35 檢舉

謝謝您的說明,也請大大幫忙優化我的程式,感恩!

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

1 個回答

marlin12

iT邦研究生 5 級 ‧ 2019-12-10 00:47:27

最佳解答

程式看似是要列出有6至9個1出現的10位元二進位數字。其實在1024個組合中，這些數字只有385個。

單看程式並不耗時，估計耗時的部份是在工作表上，從欄位p3至y3去運算出欄位m53,n53,o3的數值。如果要加快完成，就要減少m53,n53,o3的運算。方法是如果那個數字有6至9個1出現，才放到工作表上運算。

Application.WorksheetFunction.Sum(Range("i1:i10")) 是把欄位i1至i10的數值加起來，但是程式未有觸及這些欄位，估計你的原意是要把變數i1至i10的數值加起來。

因此，程式可以優化為

Sub wsj()
  Application.EnableEvents = False
  Application.Interactive = False
  Application.ScreenUpdating = False
  Application.DisplayStatusBar = False

  Dim i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, k As Integer
  k = 1

  With Worksheets("工作表1")
    For i1 = 0 To 1
      For i2 = 0 To 1
        For i3 = 0 To 1
          For i4 = 0 To 1
            For i5 = 0 To 1
              For i6 = 0 To 1
                For i7 = 0 To 1
                  For i8 = 0 To 1
                    For i9 = 0 To 1
                      For i10 = 0 To 1
                        Dim bits As Variant: bits = Array(i1, i2, i3, i4, i5, i6, i7, i8, i9, i10)
                        
                        Dim numOfOnes As Integer: numOfOnes = Application.WorksheetFunction.Sum(bits)
    
                        If (numOfOnes > 5) And (numOfOnes < 10) Then
                          .Range("p3:y3") = bits

                           k = k + 1

                          .Range("aa" & k & ":aj" & k) = bits
                          .Range("ak" & k) = .Range("m53")
                          .Range("al" & k) = .Range("n53")
                          .Range("bm" & k) = .Range("o3")
                        End If
                      Next i10
                    Next i9
                  Next i8
                Next i7
              Next i6
            Next i5
          Next i4
        Next i3
      Next i2
    Next i1
  End With

  Application.EnableEvents = True
  Application.Interactive = True
  Application.ScreenUpdating = True
  Application.DisplayStatusBar = True
End Sub

回應 5
分享
檢舉

看更多先前的回應...收起先前的回應...

wsj iT邦新手 5 級 ‧ 2019-12-10 12:45:22 檢舉

請問大大,我依照您的建議修改後run,因原始程式是i1到i40,所以run當中模組視窗上方時時顯示執行中,或執行中(沒有回應),是否哪裡可以再優化,因我的記憶體只有2g,所以執行也不知道會到何時才能結束,感謝您!

marlin12 iT邦研究生 5 級 ‧ 2019-12-10 20:15:09 檢舉

如果想知道執行的進度，可以在回圈中加入Debug.Print，去回報目前的狀況。

如果要再加速，就要避免存取工作表和運用上面的函式，它們是拖慢運算的元凶。並且

在工作表上移除全部無關的儲存格
在工作表上移除全部的函式，全部運算改用VBA來達成
把VBA全部運算的結果，先用變數儲存起來，最後才把結果放回工作表

  Dim i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, x, y As Integer
  
  Dim result(384, 12) As Integer  '用來暫存運算的結果
  
  x = 0

  '整個運算過程，避免存取工作表和運用上面的函式
  For i1 = 0 To 1
    ...  ...  ...
      For i10 = 0 To 1
        Dim bits As Variant: bits = Array(i1, i2, i3, i4, i5, i6, i7, i8, i9, i10)
                       
        Dim numOfOnes As Integer: numOfOnes = Application.WorksheetFunction.Sum(bits)
    
        If (numOfOnes > 5) And (numOfOnes < 10) Then
          For y = 0 To 9
            result(x, y) = bits(y)
          Next y
    
          result(x, 10) = 改用VBA運算出m53儲存格的結果
          result(x, 11) = 改用VBA運算出n53儲存格的結果
          result(x, 12) = 改用VBA運算出o3儲存格的結果
                          
           x = x + 1
                          
           If (x Mod 100) = 0 Then
             '回報目前的進度
             Debug.Print ("item count = " & x)
           End If
         End If
       Next i10
     ...  ...  ...   
   Next i1
    
   '最後才把整個結果放到工作表上
   Worksheets("工作表1").Range("aa2:am386") = result