返回列表 上一主題 發帖

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

01300607

帖子
13 
主題
4 
精華
0 
積分
18 
點名
0  
作業系統
OSX10.8 
軟體版本
excel2010 
閱讀權限
10 
性別
男 
註冊時間
2013-3-14 
最後登錄
2018-3-16 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 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
收藏 分享
hi

01300607

帖子
13 
主題
4 
精華
0 
積分
18 
點名
0  
作業系統
OSX10.8 
軟體版本
excel2010 
閱讀權限
10 
性別
男 
註冊時間
2013-3-14 
最後登錄
2018-3-16 
2#
發表於 2013-3-19 23:05 | 顯示全部帖子
Map.zip (12.2 KB)

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

TOP

01300607

帖子
13 
主題
4 
精華
0 
積分
18 
點名
0  
作業系統
OSX10.8 
軟體版本
excel2010 
閱讀權限
10 
性別
男 
註冊時間
2013-3-14 
最後登錄
2018-3-16 
3#
發表於 2013-3-19 23:59 | 顯示全部帖子
對不起，我的表達能力有點差
我要比對sheet1跟sheet2的資料，可是要比對的項目並非完全相同，
所以我將sheet2的資料以sheet3為對照表，再跟sheet1的資料進行比對，
最後比對出來把sheet2的資料填到sheet1
可能我的程式碼有點問題，才讓您看不懂
謝謝版主幫忙
hi

TOP

01300607

帖子
13 
主題
4 
精華
0 
積分
18 
點名
0  
作業系統
OSX10.8 
軟體版本
excel2010 
閱讀權限
10 
性別
男 
註冊時間
2013-3-14 
最後登錄
2018-3-16 
4#
發表於 2013-3-20 00:27 | 顯示全部帖子
我找出錯誤了，原來是vlookup function 比對出現error所以整個程式才出現問題
感謝版主
hi

TOP

01300607

帖子
13 
主題
4 
精華
0 
積分
18 
點名
0  
作業系統
OSX10.8 
軟體版本
excel2010 
閱讀權限
10 
性別
男 
註冊時間
2013-3-14 
最後登錄
2018-3-16 
5#
發表於 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
複製代碼
感謝板主幫忙，又學到了，謝謝
hi

TOP

        靜思自在 : 甘願做、歡喜受。
返回列表 上一主題