Board logo

標題: 兩筆資料間接比對(使用vlookup) [打印本頁]
作者: 01300607    時間: 2013-3-19 22:21     標題: 兩筆資料間接比對(使用vlookup)

我有兩筆資料要比對，可是我要比較的欄位資料並不完全相同，例如，在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    時間: 2013-3-19 22:47

回復 1# 01300607


    你自己都說執行出現錯誤了，還問這樣可以嗎?這不是很矛盾嗎?
上傳你的檔案看看
作者: 01300607    時間: 2013-3-19 23:05

[attach]14404[/attach]

不好意思，這是我的檔案
我只想知道是有根本上的錯誤，還是一些其他比較小的地方所造成的錯誤
謝謝大家幫忙
作者: Hsieh    時間: 2013-3-19 23:48

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

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

我找出錯誤了，原來是vlookup function 比對出現error所以整個程式才出現問題
感謝版主
作者: Hsieh    時間: 2013-3-20 08:42

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

  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    時間: 2013-3-20 12:02

板主的方式我之前都沒想過，依照板主的方式也能達到我要的效果，而且不用使用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")

  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
複製代碼
感謝板主幫忙，又學到了，謝謝



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)