返回列表 上一主題 發帖

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

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

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

回復 25# fyo00241

我先將你提供的資料建立在G1:H25【cells(1,7),cells(25,8)】

再用PasteData()貼10000筆資料

因為我覺得比對的過程蠻像 Select Case ,所以Sub取名為LikeSelectCase()

你參考看看,一下子就完成了


Sub PasteData()

j = 1

For i = 1 To 10000
    Cells(i, 1) = Cells(j, 7)
    j = j + 1
    If j = 26 Then j = 1
Next i

End Sub

Sub LikeSelectCase()

For i = 1 To 10000

Cells(i, 2) = Application.WorksheetFunction.VLookup(Cells(i, 1), Range(Cells(1, 7), Cells(25, 8)), 2, False)

Next i

End Sub


TOP

回復 20# fyo00241
建議樓主將所有資料置於一個資料庫(如:日記帳)

回復 22# fyo00241
2007 不行阿
請加上 With Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Offset(1)

TOP

有沒有試過用Excel內建函數【VLOOKUP】,應該也蠻快的喔!

也可以把Excel內建函數寫在VBA裡,這樣程式只有 ...
lcc_seven 發表於 2012-1-3 18:20


感謝大大,煩請你提供一下我在實作看看..謝謝!!

TOP

本帖最後由 lcc_seven 於 2012-1-3 18:24 編輯

有沒有試過用Excel內建函數【VLOOKUP】,應該也蠻快的喔!

也可以把Excel內建函數寫在VBA裡,這樣程式只有短短幾行,不過語法我忘記了

缺點是工作表要有一個位置放對應表

晚上我再翻一下書把相關語法PO上來

TOP

大大再麻煩你寄給我,謝謝了!
fyo00241 發表於 2012-1-3 17:19


大大已收到了,測了一下速度也可以,但滑鼠執行時的圖示會久一點,不知是否正常..

TOP

回復  fyo00241
簡化 UserForm1各單位工作表的Worksheet_Change 可刪除置於ThisWorkbook 中
GBKEE 發表於 2012-1-1 09:31



大大這段錯誤:無物件With Cells(Rows.Count, "A").End(xlUp).Offset(1)   '工作表(ComboBox2)

TOP

回復  GBKEE


    自己改的 不知如何
register313 發表於 2012-1-3 08:28



    大大再麻煩你寄給我,謝謝了!

TOP

回復  register313
說明一下功能有沒有問題(那邊有問題)  操作速度正不正常
樓主檔案較大,所以執行程式速 ...
GBKEE 發表於 2012-1-3 08:22


大大你說的資料庫部份是如何做較好呢??

TOP

回復  fyo00241

是不是先把之前修改過的作個測試
說明一下功能有沒有問題(那邊有問題)  操作速度正不正 ...
register313 發表於 2012-1-2 23:39


大大你之前改的我測了一下可以的速度可以接受了!!

TOP

        靜思自在 : 有心就有福,有願就有力,自造福田,自得福緣。
返回列表 上一主題