返回列表 上一主題 發帖

VAB 資料比對及轉寫

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
1# 跳轉到 »
發表於 2016-3-25 00:29 | 顯示全部帖子
本帖最後由 luhpro 於 2016-3-25 00:38 編輯

回復 1# maggie1313
一般若遇到 "有一個共同的KEY 值(不會重覆)" 這類的需求,
我會優先使用 Directory 函數來實現.

因為你沒提供範例Excel檔案,
所以我另外做一個,
你可以參照修改實現你的需求.
  1. Private Sub cbMerge_Click()
  2.   Dim lRow&
  3.   Dim sStr$
  4.   Dim vD1, vD2
  5.   
  6.   Set vD1 = CreateObject("Scripting.Dictionary")
  7.   Set vD2 = CreateObject("Scripting.Dictionary")
  8.   
  9.   Sheets("合併").Range([B2], [C100]).Clear
  10.   
  11.   With Sheets("索引一")
  12.     lRow = 2
  13.     While .Cells(lRow, 1) <> ""
  14.       vD1(CStr(.Cells(lRow, 1))) = .Cells(lRow, 2)
  15.       lRow = lRow + 1
  16.     Wend
  17.   End With
  18.   
  19.   With Sheets("索引二")
  20.     lRow = 2
  21.     While .Cells(lRow, 1) <> ""
  22.       vD2(CStr(.Cells(lRow, 1))) = .Cells(lRow, 2)
  23.       lRow = lRow + 1
  24.     Wend
  25.   End With

  27.   With Sheets("合併")
  28.     lRow = 2
  29.     While .Cells(lRow, 1) <> ""
  30.       sStr = .Cells(lRow, 1)
  31.       .Cells(lRow, 2) = vD1(sStr)
  32.       .Cells(lRow, 3) = vD2(sStr)
  33.       lRow = lRow + 1
  34.     Wend
  35.   End With
  36. End Sub
複製代碼
Dictionary實做.zip (10.02 KB)

補充:
如果需要用到整列中不只一欄的資料,
可以索引 列號:
vD1(CStr(.Cells(lRow, 1))) = lRow
再用
Sheets("合併").Cells(lRow, 2) = Sheets("索引一").Cells(vD1(sStr), 欄號)
來取得想要的資料.

另外,建議大家開題文中儘量能一併提供已經打好範例資料的Excel檔案,
這樣回文的人才不用還要自己依照圖片內容一個一個輸入資料建Excel檔案,
可以把時間專注在如何實現你的需求上.

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
2#
發表於 2016-3-25 23:33 | 顯示全部帖子
回復 3# kim223824
那就改以 編號_姓名 或是 編號_城市  的組合鍵值來做區分.
其中的 _ 可以改為任何系統可接受並足資區分的符號或文數字來取代.

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
3#
發表於 2016-3-29 21:46 | 顯示全部帖子
本帖最後由 luhpro 於 2016-3-29 21:51 編輯

回復 5# maggie1313
你沒有提供正確結果範例,所以我只能用猜的:
  1. Sub nn()
  2.   Dim lRow&
  3.   Dim wsSou As Worksheet, wsTar As Worksheet
  4.   Dim vD
  5.   
  6.   Set vD = CreateObject("Scripting.Dictionary")
  7.   Set wsSou = Sheets("EF單身")
  8.   Set wsTar = Sheets("合併資料")
  9.   
  10.   lRow = 2
  11.   With wsSou
  12.     While .Cells(lRow, 8) <> ""
  13.       wsTar.Cells(lRow, 1) = .Cells(lRow, 8)
  14.       wsTar.Cells(lRow, 2) = .Cells(lRow, 9) & "-" & .Cells(lRow, 10)
  15.       vD(CStr(.Cells(lRow, 8) & "-" & .Cells(lRow, 9) & "-" & .Cells(lRow, 10))) = lRow
  16.       lRow = lRow + 1
  17.     Wend
  18.   End With
  19. End Sub
複製代碼

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
4#
發表於 2016-4-1 03:08 | 顯示全部帖子
本帖最後由 luhpro 於 2016-4-1 03:14 編輯
回復  luhpro
你好，感謝你的解答。測試後是OK的。但現在我有另個問題想請問，如圖
就是我們的合併資料要 ...
maggie1313 發表於 2016-3-30 11:12

同我 2# 所述,
這裡依你結果資料來看只需要抓單一資料,
故 Dictionary 直接存該資料.
  1. Sub DATABASE()
  2.   Dim lRow& ' 列號
  3.   Dim wsSou1 As Worksheet, wsSou2 As Worksheet, wsTar As Worksheet '工作表
  4.   Dim vD
  5.   
  6.   Set vD = CreateObject("Scripting.Dictionary")
  7.   Set wsSou1 = Sheets("EF單頭")
  8.   Set wsSou2 = Sheets("EF單身")
  9.   Set wsTar = Sheets("合併資料")
  10.   
  11.   With wsTar ' With wsTar 與 End With 間若有以 . 開頭的指令, 其 . 等同 wsTar (亦即 Sheets("合併資料"))
  12.     .Range(.[A2], .[D50]).Clear ' 等同 wsTar.Range(wsTar.[A2], wsTar.[D50]).Clear  .[A2]=wsTar.Range("A2")
  13.   End With
  14.   
  15.   lRow = 1 ' 因為沒有標題列, 故從第1列開始抓
  16.   With wsSou1 ' EF單頭
  17.     While .Cells(lRow, 8) <> "" ' Cells(列號, 欄號) 欄號 8 = H 攔, 逐列抓取資料
  18.      vD(CStr(.Cells(lRow, 8) & "-" & .Cells(lRow, 9))) = .Cells(lRow, 14) ' vD("ODMGET_M00602-201602220001") = 4355 若只要抓金額,那就直接放金額
  19.       lRow = lRow + 1
  20.     Wend
  21.   End With
  22.   
  23.   lRow = 2
  24.   With wsSou2 ' EF單身
  25.     wsTar.Range(wsTar.[A2], wsTar.[D20]).Clear ' 清除上次產生的資料, 正式使用可以刪掉此行
  26.     While .Cells(lRow, 8) <> ""
  27.       wsTar.Cells(lRow, 1) = .Cells(lRow, 8)
  28.       wsTar.Cells(lRow, 2) = .Cells(lRow, 9) & "-" & .Cells(lRow, 10)
  29.         ' 用 "-" 是因為 鍵(Key, 索引)值 內沒有 "-", 故以其做為兩攔資料的銜接符號,避免類似111222333 加上 123456 與 1112223331 加上 23456 兩者會視為相同的問題.
  30.       wsTar.Cells(lRow, 3) = vD(CStr(.Cells(lRow, 8) & "-" & .Cells(lRow, 9))) ' 從 Dictionary 中索引 EF單頭 的金額
  31.       wsTar.Cells(lRow, 4) = .Cells(lRow, 18) ' 從 R 攔(欄號 = 18)直接抓金額
  32.       lRow = lRow + 1
  33.     Wend
  34.   End With
  35. End Sub
複製代碼
VAB 資料比對及轉寫.zip (24.85 KB)

補充 :  剛剛才看到 第二頁 的發文,
所以列號起始數字沒變,
你可以直接改成你需要的數字就可以了.

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
5#
發表於 2016-4-2 22:14 | 顯示全部帖子
本帖最後由 luhpro 於 2016-4-2 22:28 編輯
回復  luhpro
目前測試都OK。還有幾個問題想要在請教
一、如果來源單頭的資料還有多筆資料要載入「合併資 ...
maggie1313 發表於 2016-4-1 11:42

我在 2# 有說了喔 :
如果需要用到整列中不只一欄的資料,
可以索引 列號:
vD1(CStr(.Cells(lRow, 1))) = lRow
再用
Sheets("合併").Cells(lRow, 2) = Sheets("索引一").Cells(vD1(sStr), 欄號)
來取得想要的資料.
只要變更欄號就可以抓該筆資料中的任一個資料,
重點是要先取得該筆資料的列號,
查詢時也是以 Key 值(列號)來索引資料的.

所以:
vD1(CStr(.Cells(lRow, 8) & "-" & .Cells(lRow, 9))) = .Cells(lRow, 14)
vD2(CStr(.Cells(lRow, 8) & "-" & .Cells(lRow, 9))) = .Cells(lRow, 15)
...
MixDB.Cells(lRow, 3) = vD1(CStr(.Cells(lRow, 8) & "-" & .Cells(lRow, 9)))
MixDB.Cells(lRow, 5) = vD2(CStr(.Cells(lRow, 8) & "-" & .Cells(lRow, 9)))

可以改成:

vD1(CStr(.Cells(lRow, 8) & "-" & .Cells(lRow, 9))) = lRow
...
MixDB.Cells(lRow, 3) = EFhand.Cells(VD1(CStr(MixDB.Cells(lRow, 1) & "-" & Right(MixDB.Cells(lRow, 2), 12))),14) ' 只抓前 12 個字(201602220001)
MixDB.Cells(lRow, 5) = EFhand.Cells(VD1(CStr(MixDB.Cells(lRow, 1) & "-" & Right(MixDB.Cells(lRow, 2), 12))),15)
程式變很長,但實際可依你需求善用 With 與 End With 簡化及利於判讀.

至於 VD2 可以留給 MixDB 用 .

三、另外我想要在請教一個問題...

vD2(CStr(MixDB.Cells(lRow, 1) & "~" & MixDB.Cells(lRow, 2)  = lRow ' 請留意同樣為避免誤判,這裡改用 "~" 而非 "-"  來做區隔.
則 單頭金額 可用 MixDB.Cells(VD2(CStr(TextBox1 & "~"  & TextBox2 & "-"  & TextBox3)), 3) 來抓 ' 假設 TextBox? 分別放 單身單別 、 單身單號 及 序號

二、另外程式中有一段我不是很清楚用意...

這只是重複驗證執行結果前清資料用的,
看你實際的需求不見得要放.

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
6#
發表於 2016-4-8 00:04 | 顯示全部帖子
回復  luhpro
...
關於第三個問題，我不是很清楚寫法。我已經有設計好一個userform的查詢畫面，裡面會有查詢的欄位目前設計三欄。
人員只要輸入查詢的資料(ps.有可能只輸入一筆，二筆，或三筆不一定)，但系統要住他所輸入的資料穩和，才會將查詢的資料「合併資料」內容複製到「查詢」的頁簽。 ...
maggie1313 發表於 2016-4-6 17:51

Excel 有個 進階篩選 的功能, 你可以試試 :

先把 User 輸入的條件依序放入 C14 ~ E14,
再執行下列指令:
  1. [A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[C13:E14], CopyToRange:=[A22], Unique:=False
複製代碼
最後再把結果 [A22].CurrentRegion  Copy 過去即可.

TOP

        靜思自在 : 【時間成就一切】時間可以造就人格，可以成就事業，也可以儲積功德。
返回列表 上一主題