可否請各位先進幫我簡化代碼

fyo00241

可以請各位先進幫小弟簡化代碼,讓他執行快一點,到後面50幾行就很慢了,謝謝各位...


Private Sub jump123()
For a = 2 To 10000
  If Cells(a, 1) = "" Then Exit For
    s = Cells(a, 4)

If s Like "201106*" Then
        Cells(a, 5) = "A"
End If
If s Like "201101*" Then
        Cells(a, 5) = "B"
End If
If s Like "201111*" Then
        Cells(a, 5) = "C"
End If
If s Like "201102*" Then
        Cells(a, 5) = "D"
End If
If s Like "201127*" Then
        Cells(a, 5) = "E"
End If
If s Like "1101*" Then
        Cells(a, 5) = "F"
End If
If s Like "1102*" Then
        Cells(a, 5) = "G"
End If
If s Like "1103*" Then
        Cells(a, 5) = "H"
End If
If s Like "1104*" Then
        Cells(a, 5) = "I"
End If
If s Like "1105*" Then
        Cells(a, 5) = "J"
End If
If s Like "1106*" Then
        Cells(a, 5) = "K"
End If
If s Like "1107*" Then
        Cells(a, 5) = "L"
End If
If s Like "1108*" Then
        Cells(a, 5) = "M"
End If
If s Like "1109*" Then
        Cells(a, 5) = "N"
End If
If s Like "1110*" Then
        Cells(a, 5) = "O"
End If
If s Like "1111*" Then
        Cells(a, 5) = "P"
End If
If s Like "1112*" Then
        Cells(a, 5) = "Q"
End If
If s Like "1113*" Then
        Cells(a, 5) = "R"
End If
If s Like "1114*" Then
        Cells(a, 5) = "S"
End If
If s Like "1115*" Then
        Cells(a, 5) = "T"
End If
If s Like "1116*" Then
        Cells(a, 5) = "U"
End If
If s Like "1117*" Then
        Cells(a, 5) = "V"
End If
If s Like "1118*" Then
        Cells(a, 5) = "X"
End If
If s Like "1119*" Then
        Cells(a, 5) = "Y"
End If
If s Like "1120*" Then
        Cells(a, 5) = "Z"
End If

   Next a

End Sub

register313

回復 1# fyo00241
初學者VBA
使用FIND更好 但試不出來

1. Private Sub EE()
   
2. Application.ScreenUpdating = False
   
3. Columns("E").Clear
   
4. For a = 2 To 10000
   
5.   For b = 2 To 26
   
6.     If Cells(a, 1) = "" Then Exit For
   
7.     If Cells(a, 4) Like Cells(b, 7) & "*" Then
   
8.        Cells(a, 5) = Cells(b, 8)
   
9.     End If
   
10.   Next b
    
11. Next a
    
12. Application.ScreenUpdating = True
    
13. End Sub

複製代碼

下載 (64.1 KB)

2011-12-28 14:06

kimbal

試試這樣(我沒有測試)
但是如果要寫10000 個cell,不會快很多.

1. Private Sub jump123()
   
2. Application.Calculation = xlCalculationManual
   
3. Application.ScreenUpdating = False
   
4. For a = 2 To 10000
   
5.   If Cells(a, 1) = "" Then Exit For
   
6.     s = Left(Cells(a, 4), 6)
   
7.     b = False
   
8.     If s = "201106" Then
   
9.         b = True
   
10.         Cells(a, 5) = "A"
    
11.     ElseIf s = "201101" Then
    
12.         b = True
    
13.         Cells(a, 5) = "B"
    
14.     ElseIf s = "201111" Then
    
15.         b = True
    
16.         Cells(a, 5) = "C"
    
17.     ElseIf s = "201102" Then
    
18.         b = True
    
19.         Cells(a, 5) = "D"
    
20.     ElseIf s = "201127" Then
    
21.         b = True
    
22.         Cells(a, 5) = "E"
    
23.     End If
    
24.     If Not (b) Then
    
25.         k1 = Left(s, 2)
    
26.         If k1 = "11" Then
    
27.             k2 = Mid(s, 3, 2)
    
28.             If k2 >= "01" And k2 <= "17" Then
    
29.                 Cells(a, 5) = Chr(69 + Val(k2))
    
30.             ElseIf k2 >= "18" And k2 <= "20" Then
    
31.                 Cells(a, 5) = Chr(70 + Val(k2))
    
32.             End If
    
33.         End If
    
34.     End If
    
35.    Next a
    
36. Application.Calculation = xlCalculationAutomatic
    
37. Application.ScreenUpdating = True
    
38. End Sub

複製代碼

fyo00241

感謝2位大大的分享,我再貼上我後來的代碼,請2位幫我簡化一下,因為速度到後面就很慢了我key條碼它判斷時就會lag了,先感謝2位了!!
arr = [d2:d10000]
For i = 1 To UBound(arr)
    s = arr(i, 1)
    If s Like "201106*" Then
        brr(i) = "手打鐘Ⅰ"

ElseIf s Like "201101*" Then
        brr(i) = "手打鐘"

ElseIf s Like "201111*" Then
        brr(i) = "手打鐘Ⅱ"

ElseIf s Like "201102*" Then
        brr(i) = "手打鐘"
        
ElseIf s Like "201103*" Then
        brr(i) = "手打鐘"

ElseIf s Like "201127*" Then
        brr(i) = "T27印表機"

ElseIf s Like "1101*" Then
        brr(i) = "中文鴿鐘"

ElseIf s Like "1102*" Then
        brr(i) = "英文鴿鐘"

ElseIf s Like "1103*" Then
        brr(i) = "中文語音鴿鐘"

ElseIf s Like "1104*" Then
        brr(i) = "英文語音鴿鐘"

ElseIf s Like "1105*" Then
        brr(i) = "中文語音鴿鐘(G)"

ElseIf s Like "1106*" Then
        brr(i) = "英文語音鴿鐘(G)"

ElseIf s Like "1107*" Then
        brr(i) = "凹槽"

ElseIf s Like "1108*" Then
        brr(i) = "CI"

ElseIf s Like "1109*" Then
        brr(i) = "單格15PIN"

ElseIf s Like "1110*" Then
       brr(i) = "單格9PIN"

ElseIf s Like "1111*" Then
        brr(i) = "四合一15PIN-E"

ElseIf s Like "1112*" Then
        brr(i) = "四合一15PIN-EL"

ElseIf s Like "1113*" Then
        brr(i) = "四合一9PIN"

ElseIf s Like "1114*" Then
        brr(i) = "GPS(方形)"

ElseIf s Like "1115*" Then
        brr(i) = "525電匠"

ElseIf s Like "1116*" Then
        brr(i) = "747電匠"

ElseIf s Like "1117*" Then
        brr(i) = "T+1感應板"

ElseIf s Like "1118*" Then
        brr(i) = "傳訊機5V"

ElseIf s Like "1119*" Then
        brr(i) = "傳訊機非5V"

ElseIf s Like "1120*" Then
        brr(i) = "UID讀碼機"
End If
           
   
Next
[E2].Resize(999, 1) = Application.WorksheetFunction.Transpose(brr)

register313

回復 4# fyo00241
1. key條碼 key在何處? 作何判斷?
2.程式功能為何?
3.很慢是大約幾秒? 依實際需求大約要幾秒完成?
4.何不附上檔案?

fyo00241

日記帳記錄.zip (832.98 KB)

password:3543
下載次數: 14

2011-12-29 08:51

回復 5# register313
麻請了是UserForm1這個地方,也請大大幫我看一下那些地方可以再簡化,順一點的謝謝了!!

register313

回復 6# fyo00241
   依我看你是用表單一次輸入1個序號(D欄),然後查出1個品名(E欄)   ===>   需1t時間  
   而不是一次已有10000個序號(D欄),),然後一次查出10000個品名(E欄)   ===>   需10000t時間(當然會慢)
  
   依之前程式之寫法
  輸入第1個序號(查詢1個)  ===>   需1t時間
  輸入第2個序號(查詢2個)  ===>   需2t時間
  輸入第1000個序號(查詢1000個)  ===>   需1000t時間
  所以累積愈多序號 到時候執行速度就愈慢

  先看看附檔範例是不是你要的
  在D欄輸入序號,馬上查出品名
  只會查有D欄變動之序號,而不是每次都全部重查

1. Private Sub worksheet_change(ByVal target As Range)
   
2. 
   
3. If target.Column = 4 Then
   
4.   a = target.Row
   
5.   For b = 2 To 27
   
6.     If Cells(a, 4) Like Cells(b, 7) & "*" Then
   
7.        Cells(a, 5) = Cells(b, 8)
   
8.     End If
   
9.   Next b
   
10. End If
    
11. 
    
12. End Sub

複製代碼

新增Microsoft Excel 工作表.rar (6.59 KB)

下載次數: 10

2011-12-29 12:59

GBKEE

回復 6# fyo00241
你附檔 的VBA 上鎖看不見

register313

回復 6# fyo00241

請問原來的程式是否能正常執行 好多地方有問題

只修正本帖所提之執行速度
試試看

日記帳記錄.zip (749.39 KB)

下載次數: 9

2011-12-29 18:52

fyo00241

回復 8# GBKEE


報告G大:3543