VBA lookup

[piches]

สวัสดีอาจารย์และเพื่อนสมาชิกทุกท่านครับ ช่วยชี้แนะด้วยครับว่าต้องแก้ไขยังไง

Code: Select all

Sub TestVBA()
    OptimizeVBA True
    Dim startTime As Single, endTime As Single
    startTime = Timer
    
    Dim invoice As Range, names As Range, Amount As Range
    Dim lookupInvoice As Range, lookupNames As Range, lookupAmount As Range
    Dim vlookupCol As Object
    
    Set invoice = Worksheets("Sheet2").Range("A2:A199")
    Set names = Worksheets("Sheet2").Range("B2:B199")
    Set Amount = Worksheets("Sheet2").Range("C2:C199")
    Set lookupInvoice = Worksheets("Sheet1").Range("A2:A12")
    Set lookupNames = Worksheets("Sheet1").Range("B2:B12")
    Set lookupAmount = Worksheets("Sheet1").Range("C2:C12")
    'Build Collection
    Set vlookupCol =[color=#FF0000] BuildLookupCollection(invoice[/color], names, Amount)
    
    'Lookup the values
    VLookupValues lookupInvoice, lookupNames, lookupAmount, vlookupCol
    endTime = Timer
    Debug.Print (endTime - startTime) & " seconds have passed [VBA]"
    OptimizeVBA False
    Set vlookupCol = Nothing
End Sub
 
Function BuildLookupCollection(categories As Range, values As Range)
    Dim vlookupCol As Object, i As Long
    Set vlookupCol = CreateObject("Scripting.Dictionary")
    For i = 1 To categories.Rows.Count
        Call vlookupCol.Add(CStr(categories(i)), values(i))
    Next i
    
    Set BuildLookupCollection = vlookupCol
End Function
 
Sub VLookupValues(lookupCategory As Range, lookupValues As Range, vlookupCol As Object)
    Dim i As Long, resArr() As Variant
    ReDim resArr(lookupCategory.Rows.Count, 1)
    For i = 1 To lookupCategory.Rows.Count
        resArr(i - 1, 0) = vlookupCol.Item(CStr(lookupCategory(i)))
    Next i
    lookupValues = resArr
End Sub
 
Sub OptimizeVBA(isOn As Boolean)
    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not (isOn)
    Application.ScreenUpdating = Not (isOn)
    ActiveSheet.DisplayPageBreaks = Not (isOn)
End Sub

[snasui]

ช่วยเล่าสิ่งที่เป็นปัญหา และแจ้งคำตอบที่ต้องการมาในกระทู้ด้วยครับ

[piches]

Set vlookupCol = BuildLookupCollection(invoice, names, Amount)ต้องแก้ไขเพิ่มเติมตรงไหนครับ
http://analystcave.com/excel-vlookup-vs ... rformance/ผมดูจากเว็ปนี้ครับแต่ไม่เข้าใจตรงนี้ครับ Set vlookupCol = BuildLookupCollection ว่ามีความหมายว่าอย่างไรครับอาจารย์

[snasui]

BuildLookupCollection คือ Function ที่ต้องส่งตัวแปรอีก 2 ตัวไปให้มันจัดการต่อ คือ categories และ values แต่จากภาพที่แนบมานั้น ผมสังเกต Error มองเห็นลาง ๆ ว่าส่งตัวแปรไปเกินกว่าจำเป็น ยกตัวอย่างเช่น ต้องการ 2 ตามด้านบน แต่ส่งไป 3 ตัว คือ invoice, name และ amout จึงฟ้องว่าส่งตัวแปรไปไม่ถูกต้องครับ

[piches]

ขอบคุณครับอาจารย์ ด้วยสมองอันน้อยนิดของผมคงอยากเกินไป มีหลายช่วงที่ไม่เข้าใจถึงความสัมพันธ์ระว่าง subและFunctionทั้ง4ช่วง
อยากสอบถามอาจารย์ว่า หากต้องการเพิ่มช่วงต้องปรับส่วนใดบ้างครับ
ขออนุญาติวาง Code เป็นข้อความนะครับ font สีแดงคือ Codeที่ผมปรับเพิ่มเติมจากเดิม ผมต้องการจะเพิ่มช่วงคนหาจากเดิม 2 ช่วง เป็น 3 ช่วง คือ collumn c ส่วน font สีน้ำเงิน ผมไมรู้จ่าจะปรับยังไงครับ

Sub TestVBA()
OptimizeVBA True
Dim startTime As Single, endTime As Single
startTime = Timer

Dim invoice As Range, names As Range, Amount As Range
Dim lookupInvoice As Range, lookupNames As Range, lookupAmount As Range
Dim vlookupCol As Object

Set invoice = Worksheets("Sheet2").Range("A2:A199")
Set names = Worksheets("Sheet2").Range("B2:B199")
Set Amount = Worksheets("Sheet2").Range("C2:C199")
Set lookupInvoice = Worksheets("Sheet1").Range("A2:A12")
Set lookupNames = Worksheets("Sheet1").Range("B2:B12")
Set lookupAmount = Worksheets("Sheet1").Range("C2:C12")
'Build Collection
Set vlookupCol = BuildLookupCollection(invoice, names, Amount)

'Lookup the values
VLookupValues lookupInvoice, lookupNames, lookupAmount, vlookupCol
endTime = Timer
Debug.Print (endTime - startTime) & " seconds have passed [VBA]"
OptimizeVBA False
Set vlookupCol = Nothing
End Sub
---------------------------------------------------------------------------------------------------
ต้องเพิ่มตัวแปลในFunctionอย่างไรครับ
Function BuildLookupCollection(categories As Range, values As Range)
Dim vlookupCol As Object, i As Long
Set vlookupCol = CreateObject("Scripting.Dictionary")
For i = 1 To categories.Rows.Count
Call vlookupCol.Add(CStr(categories(i)), values(i))
Next i

Set BuildLookupCollection = vlookupCol
End Function
--------------------------------------------------------------------------------------------------

Sub VLookupValues(lookupCategory As Range, lookupValues As Range, vlookupCol As Object)
Dim i As Long, resArr() As Variant
ReDim resArr(lookupCategory.Rows.Count, 1)
For i = 1 To lookupCategory.Rows.Count
resArr(i - 1, 0) = vlookupCol.Item(CStr(lookupCategory(i)))
Next i
lookupValues = resArr
End Sub
-------------------------------------------------------------------------------------------------
Sub OptimizeVBA(isOn As Boolean)
Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
Application.EnableEvents = Not (isOn)
Application.ScreenUpdating = Not (isOn)
ActiveSheet.DisplayPageBreaks = Not (isOn)
End Sub

[snasui]

ตัวอย่างการใส่ Arguments ของ Function และ Procedure ให้สอดคล้องกับการส่งค่าเข้าไปให้ตามด้านล่างครับ

Code: Select all

Function BuildLookupCollection(categories As Range, values As Range, amt As Range)
    Dim vlookupCol As Object, i As Long
    Set vlookupCol = CreateObject("Scripting.Dictionary")
    For i = 1 To categories.Rows.Count
        Call vlookupCol.Add(CStr(categories(i)), values(i))
    Next i
    
    Set BuildLookupCollection = vlookupCol
End Function
 
Sub VLookupValues(lookupCategory As Range, lookupValues As Range, amt As Range, vlookupCol As Object)
    Dim i As Long, resArr() As Variant
    ReDim resArr(lookupCategory.Rows.Count, 1)
    For i = 1 To lookupCategory.Rows.Count
        resArr(i - 1, 0) = vlookupCol.Item(CStr(lookupCategory(i)))
    Next i
    lookupValues = resArr
End Sub