返回列表 上一主題 發帖

麻煩各位大師 資料替換問題

toxin

帖子
50 
主題
11 
精華
0 
積分
72 
點名
0  
作業系統
WIN XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2012-3-20 
最後登錄
2024-10-20 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-6-6 08:41 | 只看該作者

麻煩各位大師 資料替換問題

VBA, excel


小弟試了好久都試不太出來
所以只能麻煩各位大大了
主要是因為個人編號不太相同
但是不同編號可能代表的是同一個東西
可以將編號對照差異表之後傳回統一的替代編號(紅色部分)
並且將替代前的編號貼到原始編號上(藍色部份)
檔案如下
0606.rar (4.73 KB)
收藏 分享

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
242  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-8 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2012-6-6 08:54 | 只看該作者
回復 1# toxin
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. With Sheet3
  4. ar = .UsedRange.Offset(1, 1).Value
  5. ay = .UsedRange.Offset(1).Columns(1).Cells.Value
  6. For i = 1 To UBound(ar, 1)
  7.    For j = 1 To UBound(ar, 2)
  8.    If ar(i, j) <> "" Then d(ar(i, j)) = ay(i, 1)
  9.    Next
  10. Next
  11. End With
  12. With Sheet1
  13. For Each a In .Range(.[A2], .[A65536].End(xlUp))
  14. a.Offset(, 4) = d(a.Value)
  15. Next
  16. End With
  17. End Sub
複製代碼
學海無涯_不恥下問

TOP

toxin

帖子
50 
主題
11 
精華
0 
積分
72 
點名
0  
作業系統
WIN XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2012-3-20 
最後登錄
2024-10-20 
3#
發表於 2012-6-6 10:37 | 只看該作者
回復 2# Hsieh
感謝Hsieh版主老師
不好意思小弟功力還不夠
可以麻煩抽個空寫一下註解嗎?
不想只是套用想多學一點東西
感謝

TOP

        靜思自在 : 盡多少本份，就得多少本事。
返回列表 上一主題