123
返回列表 上一主題 發帖

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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8# 跳轉到 »
發表於 2011-12-29 15:40 | 只看該作者
回復 6# fyo00241
你附檔 的VBA 上鎖看不見

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欄變動之序號,而不是每次都全部重查
  1. Private Sub worksheet_change(ByVal target As Range)

  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

  12. End Sub
複製代碼
新增Microsoft Excel 工作表.rar (6.59 KB)

TOP

fyo00241

帖子
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龍年全勤獎章熱烈參與勳章
5#
發表於 2011-12-29 08:23 | 只看該作者
本帖最後由 register313 於 2011-12-29 08:29 編輯

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

TOP

fyo00241

帖子
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

kimbal

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

論壇貢獻勳章
3#
發表於 2011-12-28 14:09 | 只看該作者
試試這樣(我沒有測試)
但是如果要寫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
複製代碼
懂得發問,答案就會在其中

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

TOP

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更好 但試不出來
  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
複製代碼

TOP

        靜思自在 : 能幹不幹，不如苦幹實幹。
123
返回列表 上一主題