兩筆資料間接比對(使用vlookup)

01300607

我有兩筆資料要比對，可是我要比較的欄位資料並不完全相同，例如，在A工作表湖人隊以Lakers表示，但在B工作表湖人隊是以LAL表示
因此我想利用vlookup的方式間接比較資料
以下是我的VBA程式碼，可是執行上卻有錯誤，請問我這樣使用對嗎?可以這樣用嗎?有其他方法能達成我的目的嗎?謝謝
Sub aa()

Dim mDic As Object
Dim mWk1 As Workbook
Dim mSht1 As Worksheet
Dim mRng As Range
Dim vRng As Range
Dim E As Range

Set mDic = CreateObject("Scripting.Dictionary")
Set mWk1 = Workbooks("Mapping1")
With mWk1
    Set mSht1 = .Worksheets(2)
    With mSht1
        Set mRng = .Range("b2:b" & .[b65536].End(xlUp).Row)
    End With
    Set vRng = .Worksheets(3).Range("a2:b11")
    For Each E In mRng
        If mDic.Exists(E.Value) = False Then
          mDic(Application.WorksheetFunction.vlookup(E.Value, vRng, 2, 0) & Application.WorksheetFunction.vlookup(E.Offset(, 2).Value, vRng, 2, 0)) = E.Offset(, 4).Resize(,2)
        End If
    Next
End With

    With Worksheets(1)

        For Each E In .Range(.[g2], .[g2].End(xlDown))

            E.Offset(, 8).Resize(, 2) = mDic(E.Value & E.Offset(, 7).Value)

        Next

    End With

End Sub

Hsieh

回復 1# 01300607


    你自己都說執行出現錯誤了，還問這樣可以嗎?這不是很矛盾嗎?
上傳你的檔案看看

01300607

Map.zip (12.2 KB)

下載次數: 14

2013-3-19 23:03

不好意思，這是我的檔案
我只想知道是有根本上的錯誤，還是一些其他比較小的地方所造成的錯誤
謝謝大家幫忙

Hsieh

回復 3# 01300607
看不懂你要比對甚麼?
照理說應該Sheet3是對照表，但是程式碼卻非以此為對照表
還是要說明清楚你的對照標準，才能知道如何修正。

01300607

對不起，我的表達能力有點差
我要比對sheet1跟sheet2的資料，可是要比對的項目並非完全相同，
所以我將sheet2的資料以sheet3為對照表，再跟sheet1的資料進行比對，
最後比對出來把sheet2的資料填到sheet1
可能我的程式碼有點問題，才讓您看不懂
謝謝版主幫忙

01300607

我找出錯誤了，原來是vlookup function 比對出現error所以整個程式才出現問題
感謝版主

Hsieh

回復 6# 01300607
不是很清楚你的比對模式
試試看結果對不對

1. Sub ex()
   
2. Dim A As Range, d As Object, d1 As Object
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. 
   
6. With Sheet3 '寫入對照表
   
7.    For Each A In .Range(.[A2], .[A2].End(xlDown))
   
8.    d(A.Value) = A.Offset(, 1)
   
9.    Next
   
10. End With
    
11. With Sheet2  '以對照名稱存入數值
    
12.    For Each A In .Range(.[B2], .[B2].End(xlDown))
    
13.    d1(d(A.Value)) = Array(A.Offset(, 4), A.Offset(, 5))
    
14.    Next
    
15. End With
    
16. With Sheet1 '將對照數值寫入
    
17.    For Each A In .Range(.[G2], .[G2].End(xlDown))
    
18.    A.Offset(, 8).Resize(, 2) = d1(d(A.Value))
    
19.    Next
    
20. End With
    
21. End Sub

複製代碼

01300607

板主的方式我之前都沒想過，依照板主的方式也能達到我要的效果，而且不用使用Vlookup function
以下是我稍微修改過的，執行後也能達到我想要的目的

1. Sub ex()
   
2. Dim A As Range, d As Object, d1 As Object
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. 
   
6. With Worksheets(3)
   
7.    For Each A In .Range(.[A2], .[A2].End(xlDown))
   
8.    d(A.Value) = A.Offset(, 1)
   
9.    Next
   
10. End With
    
11. With Worksheets(2)
    
12.    For Each A In .Range(.[B2], .[B2].End(xlDown))
    
13.    d1(d(A.Value) & d(A.Offset(, 2).Value)) = Array(A.Offset(, 4), A.Offset(, 5))
    
14.    Next
    
15. End With
    
16. With Worksheets(1)
    
17.    For Each A In .Range(.[G2], .[G2].End(xlDown))
    
18.    A.Offset(, 8).Resize(, 2) = d1(A.Value & A.Offset(, 7).Value)
    
19.    Next
    
20. End With
    
21. End Sub

複製代碼

感謝板主幫忙，又學到了，謝謝