[發問] vlookup速度慢，使用vba取代的程式碼

chiang0320

當遇到資料量十幾萬筆的情況下，使用vlookup函數速度會很慢
詢問google大師有這麼一段程式碼
但是試著套，會出現溢位的錯誤，請問是否能幫忙修改程式碼，謝謝!

下載 (60.37 KB)

2018-6-15 14:49

下載 (43.71 KB)

2018-6-15 14:47

取代Vlookup.tar (318 KB)

o
下載次數: 43

2018-6-15 14:45

Qin

回復 23# 准提部林


想起尚未回覆准大的問題

CHANGE觸發的程式，就無法再使用〔復原〕

不了, 還是讓它保留原狀

謝謝!!


   








終于想起步驟的"驟"字了..

Qin

回復 23# 准提部林

好的, 在努力學習中....

准提部林

回復 22# Qin

１）要去了解每一行程式碼的意思, 不然問一堆會沒完沒了～～～～
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xR As Range, xF As Range, xCr, xCf, j%
xCr = Array(3, 6, 7)
xCf = Array(2, 4, 5)
With Target.Columns(1)  '貼入或輸入區的第一欄
     If .Column <> 1 Then Exit Sub
     For Each xR In .Cells
         If .Row = 1 Then GoTo 101
         xR(1, 3).Resize(1, 5).ClearContents
         If xR = "" Then GoTo 101
         Set xF = Sheet1.[A:A].Find(xR, LookAt:=xlWhole, MatchCase:=False)
         If xF Is Nothing Then GoTo 101
         For j = 0 To UBound(xCr)
             xR(1, xCr(j)) = xF(1, xCf(j)).Value
         Next j
101: Next
End With
End Sub
　
２）CHANGE觸發的程式，就無法再使用〔復原〕！
　
　
　

Qin

回復 21# 准提部林

准大
以上的問題解決了, 實在是太棒了,它簡化了我工作的流程. 感激!!

不好意思, 還有一點小問題
之前沒注意到...

1) 想將 L ,M 單元格的資料 copy 去 A & B 欄里,
為何C , F & G 的資料就抓不出來了??

2) 有時會因為手誤, 誤刪A欄的資料, 為何不能用" Ctrl Z" Undo 重新叫出來?

    bcca2.rar (43.29 KB)

下載次數: 9

2018-11-25 18:32

准提部林

回復 20# Qin


Sub CopyPaste()
Dim xA As Range, xB As Workbook, xS As Worksheet, Chk%
Set xA = ActiveSheet.UsedRange
Application.ScreenUpdating = False
Set xB = Workbooks.Open(ThisWorkbook.Path & "\bcca.xls", Password:="1234")
For Each xS In xB.Sheets
    If Left(xS.Name, 6) = "w_PRG_" Then Chk = 1: Exit For
Next
If Chk = 0 Then MsgBox "工作表〔w_PRG〕不存在！　": Exit Sub
With xS
    .Unprotect "pass"
    .UsedRange.Clear
     xA.Copy .[A1]
     .UsedRange.Font.Color = vbWhite
     .Name = "w_PRG_" & Format(Date, "yyyymmdd")
     .Protect "pass"
End With
xB.Close 1
MsgBox "複製完成！　"
End Sub

Qin

回復 19# 准提部林

准大
謝謝你又幫了我個大忙
1)讓我可以任意使用不同的欄位
2)50頁工作表不因工作表名稱變動的問題解決了, 免去了需要逐頁去修改的煩惱

想再請問, 有沒有這樣異想天開的寫法
就是當我把wPrg資料複製去bcca 檔時,是否也可以同時修改工作表名稱並加上當天日期. " w_PRG_20181124"

因為有太多像這樣的檔要處理, 如果以上的要求可以實現, 那實在是太完美了.

wPrg1.rar (61.94 KB)

下載次數: 4

2018-11-24 23:26

准提部林

回復 18# Qin

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xR As Range, xF As Range, xCr, xCf, j%
xCr = Array(3, 6, 7) '本表要貼入的欄位
xCf = Array(2, 4, 5) '來源表要複製的欄位
With Target
     If .Columns.Count > 1 Or .Column <> 1 Then Exit Sub
     For Each xR In .Cells
         If .Row = 1 Then GoTo 101
         xR(1, 2).Resize(1, 7).ClearContents
         If xR = "" Then GoTo 101
         Set xF = Sheet1.[A:A].Find(xR, LookAt:=xlWhole, MatchCase:=False)
         '_Sheet1為來源表的[屬性名稱], 工作表名稱可任意更改而不影響(見下圖)
         If xF Is Nothing Then GoTo 101
         For j = 0 To UBound(xCr)
             xR(1, xCr(j)) = xF(1, xCf(j)).Value
         Next j
101: Next
End With
End Sub

下載 (19.68 KB)

2018-11-19 16:41

Qin

回復 16# 准提部林

可以只對A欄單一儲存格輸入取對應值, 或一次貼入多個查詢值取對應~~

  
太糗了, 原來一篇程式碼就能解決的事 我卻儍儍的以為要用2篇才能實現
准大你太牛了啦…
這完全是我想要的效果.
高興後, 卻發現自己不懂得修改欄位.
因為有很多Excel 檔都要用到此程式碼
因此又再厚顏上來發問.

問題在附檔
bcca 檔 password :  1234    &   pass

wPrg.rar (65.25 KB)

下載次數: 14

2018-11-17 23:17

n7822123

回復 15# Qin


字典可設定是否區分大小寫
預設模式下，會區分大小寫
把字典的CompareMode屬性設為1，即不分大小寫
以下是Test範例

Sub ex()
Set D = CreateObject("scripting.dictionary")
D.CompareMode = 1      '字典不區分大小寫
D("abc") = 22
D("ABC") = 55
MsgBox D("abc") & "," & D("ABC")
End Sub

詳細VBA說明如下圖

下載 (18.71 KB)

2018-11-11 11:51