帖子: 19
主題: 1
精華: 0
積分: 50
點名: 0
作業系統: windows7
軟體版本: Office2007
閱讀權限: 20
註冊時間: 2011-10-10
最後登錄: 2023-12-14

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2011-12-27 22:28 | 只看該作者

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

可以請各位先進幫小弟簡化代碼,讓他執行快一點,到後面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

　頭銜: 麻辣路人甲

大學生 Rank: 4

帖子: 967
主題: 0
精華: 0
積分: 1001
點名: 0
作業系統: WIN XP
軟體版本: OFFICE 2003
閱讀權限: 50
性別: 男
來自: 台北
註冊時間: 2010-11-29
最後登錄: 2022-5-17

2012龍年全勤獎章熱烈參與勳章

2^#

發表於 2011-12-28 14:07 | 只看該作者

本帖最後由 register313 於 2011-12-28 14:09 編輯

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

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

複製代碼

TOP

kimbal

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 472
主題: 5
精華: 0
積分: 485
點名: 0
作業系統: Windows
軟體版本: MS Office
閱讀權限: 100
性別: 男
來自: 香港
註冊時間: 2010-7-4
最後登錄: 2014-12-28

論壇貢獻勳章

3^#

發表於 2011-12-28 14:09 | 只看該作者

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

Private Sub jump123()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For a = 2 To 10000
If Cells(a, 1) = "" Then Exit For
s = Left(Cells(a, 4), 6)
b = False
If s = "201106" Then
b = True
Cells(a, 5) = "A"
ElseIf s = "201101" Then
b = True
Cells(a, 5) = "B"
ElseIf s = "201111" Then
b = True
Cells(a, 5) = "C"
ElseIf s = "201102" Then
b = True
Cells(a, 5) = "D"
ElseIf s = "201127" Then
b = True
Cells(a, 5) = "E"
End If
If Not (b) Then
k1 = Left(s, 2)
If k1 = "11" Then
k2 = Mid(s, 3, 2)
If k2 >= "01" And k2 <= "17" Then
Cells(a, 5) = Chr(69 + Val(k2))
ElseIf k2 >= "18" And k2 <= "20" Then
Cells(a, 5) = Chr(70 + Val(k2))
End If
End If
End If
Next a
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

複製代碼

懂得發問,答案就會在其中

今日の一秒は明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

fyo00241

中學生 Rank: 2

帖子: 19
主題: 1
精華: 0
積分: 50
點名: 0
作業系統: windows7
軟體版本: Office2007
閱讀權限: 20
註冊時間: 2011-10-10
最後登錄: 2023-12-14

4^#

發表於 2011-12-29 01:12 | 只看該作者

本帖最後由 fyo00241 於 2011-12-29 01:13 編輯

感謝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)

TOP

register313

　頭銜: 麻辣路人甲

大學生 Rank: 4

帖子: 967
主題: 0
精華: 0
積分: 1001
點名: 0
作業系統: WIN XP
軟體版本: OFFICE 2003
閱讀權限: 50
性別: 男
來自: 台北
註冊時間: 2010-11-29
最後登錄: 2022-5-17

2012龍年全勤獎章熱烈參與勳章

5^#

發表於 2011-12-29 08:23 | 只看該作者

本帖最後由 register313 於 2011-12-29 08:29 編輯

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

TOP

fyo00241

中學生 Rank: 2

帖子: 19
主題: 1
精華: 0
積分: 50
點名: 0
作業系統: windows7
軟體版本: Office2007
閱讀權限: 20
註冊時間: 2011-10-10
最後登錄: 2023-12-14

6^#

發表於 2011-12-29 08:52 | 只看該作者

本帖最後由 fyo00241 於 2011-12-29 08:56 編輯

日記帳記錄.zip (832.98 KB)
回復 5# register313
麻請了是UserForm1這個地方,也請大大幫我看一下那些地方可以再簡化,順一點的謝謝了!!

TOP

register313

　頭銜: 麻辣路人甲

大學生 Rank: 4

帖子: 967
主題: 0
精華: 0
積分: 1001
點名: 0
作業系統: WIN XP
軟體版本: OFFICE 2003
閱讀權限: 50
性別: 男
來自: 台北
註冊時間: 2010-11-29
最後登錄: 2022-5-17

2012龍年全勤獎章熱烈參與勳章

7^#

發表於 2011-12-29 12:59 | 只看該作者

回復 6# fyo00241
依我看你是用表單一次輸入1個序號(D欄),然後查出1個品名(E欄) ===> 需1t時間
而不是一次已有10000個序號(D欄),),然後一次查出10000個品名(E欄) ===> 需10000t時間(當然會慢)

依之前程式之寫法
  輸入第1個序號(查詢1個)  ===> 需1t時間
  輸入第2個序號(查詢2個)  ===> 需2t時間
  輸入第1000個序號(查詢1000個)  ===> 需1000t時間
  所以累積愈多序號到時候執行速度就愈慢

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