帖子: 45
主題: 15
精華: 0
積分: 92
點名: 0
作業系統: ?
軟體版本: ?
閱讀權限: 20
註冊時間: 2016-3-17
最後登錄: 2019-11-19

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2018-6-15 14:50 | 只看該作者

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

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

取代Vlookup.tar (318 KB)

樓主熱帖

Qin

中學生 Rank: 2

帖子: 207
主題: 61
精華: 0
積分: 270
點名: 0
作業系統: Vista
軟體版本: office2003
閱讀權限: 20
性別: 女
註冊時間: 2011-3-20
最後登錄: 2023-6-25

25^#

發表於 2018-12-2 10:19 | 只看該作者

回復 23# 准提部林

想起尚未回覆准大的問題

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

不了, 還是讓它保留原狀

謝謝!!

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

TOP

Qin

中學生 Rank: 2

帖子: 207
主題: 61
精華: 0
積分: 270
點名: 0
作業系統: Vista
軟體版本: office2003
閱讀權限: 20
性別: 女
註冊時間: 2011-3-20
最後登錄: 2023-6-25

24^#

發表於 2018-11-25 23:44 | 只看該作者

回復 23# 准提部林

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

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

23^#

發表於 2018-11-25 19:37 | 只看該作者

回復 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觸發的程式，就無法再使用〔復原〕！
　
　
　

TOP

Qin

中學生 Rank: 2

帖子: 207
主題: 61
精華: 0
積分: 270
點名: 0
作業系統: Vista
軟體版本: office2003
閱讀權限: 20
性別: 女
註冊時間: 2011-3-20
最後登錄: 2023-6-25

22^#

發表於 2018-11-25 18:33 | 只看該作者

回復 21# 准提部林

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

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

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

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

bcca2.rar (43.29 KB)

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

21^#

發表於 2018-11-25 11:46 | 只看該作者

回復 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

TOP

Qin

中學生 Rank: 2

帖子: 207
主題: 61
精華: 0
積分: 270
點名: 0
作業系統: Vista
軟體版本: office2003
閱讀權限: 20
性別: 女
註冊時間: 2011-3-20
最後登錄: 2023-6-25

20^#

發表於 2018-11-24 23:26 | 只看該作者

回復 19# 准提部林

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

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

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

wPrg1.rar (61.94 KB)

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

19^#

發表於 2018-11-19 16:34 | 只看該作者

本帖最後由准提部林於 2018-11-19 16:42 編輯

回復 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

TOP

Qin

中學生 Rank: 2

帖子: 207
主題: 61
精華: 0
積分: 270
點名: 0
作業系統: Vista
軟體版本: office2003
閱讀權限: 20
性別: 女
註冊時間: 2011-3-20
最後登錄: 2023-6-25

18^#

發表於 2018-11-17 23:17 | 只看該作者

回復 16# 准提部林

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

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

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

wPrg.rar (65.25 KB)

TOP

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

17^#

發表於 2018-11-11 11:49 | 只看該作者

本帖最後由 n7822123 於 2018-11-11 11:53 編輯

回復 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說明如下圖

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP