[發問] A表每單筆資料去查詢B表 得出多列資料 複製到C表 [0613]成功嚕

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

12^#

發表於 2010-6-13 21:48 | 只看該作者

效能如何就看你記憶體夠不夠
如果變數都完成宣告就會好一點

學海無涯_不恥下問

帖子: 10
主題: 2
精華: 0
積分: 19
點名: 0
作業系統: windows
軟體版本: office 2007
閱讀權限: 10
註冊時間: 2010-5-29
最後登錄: 2011-10-12

論壇贊助勳章

11^#

發表於 2010-6-13 21:18 | 只看該作者

Sub matchdata()
Dim Ay() '全域變數Ay用來放最終結果
Set d = CreateObject("Scripting.Dictionary") '創立一個二維陣列的物件d
With Sheet2
For Each A In .Range(.[A2], .[A65536].End(xlUp)) '第二張表的A欄逐列 =暫存變數A
If d.exists(A.Value) = False Then '用Dictionary的Exists函數來檢查比對A的值如果沒有則執行下一行
d(A.Value) = Join(Array(A, A.Offset(, 1), A.Offset(, 2), A.Offset(, 3)), ",") '取值?? 橫向的 1A,1B,1C 醬
Else '如果有
d(A.Value) = d(A.Value) & ";" & Join(Array(A, A.Offset(, 1), A.Offset(, 2), A.Offset(, 3)), ",") '串聯起來用;隔開變成1A,1B,1C;2A,2B,2C 取出的時候會變成兩列或更多列的三欄資料
End If
Next
End With
With Sheet1
For Each A In .Range(.[C2], .[C65536].End(xlUp)) '第一張表的C欄逐列 =暫存變數A
If d.exists(A.Value) = True Then '二維陣列d的物件若有包含這次的變數a
Ar = Split(d(A.Value), ";") '取出可用的數筆資料直向的可用筆數 X ABC三欄
For i = 0 To UBound(Ar) '0到陣列Ar的最大值
ReDim Preserve Ay(s) '保存動態陣列的內容 (為什麼儲存寫在前面處理方式寫在下一行?)
Ay(s) = Split(A.Offset(, -2) & "," & A.Offset(, -1) & "," & Ar(i), ",")
s = s + 1 '目前列+1
Next
Else
If mystr = "" Then mystr = A Else mystr = mystr & "," & A '若d.exists(A.Value) = false 寫入一個警告顯示目前變數A
End If
Next
End With
With Sheet3
.[A2:F65536] = "" '清空第三張表
.[A2].Resize(s, 6) = Application.Transpose(Application.Transpose(Ay)) '第三張表的A2欄開始寫入轉換過的行列轉換了兩次超深奧無法想像..
MsgBox mystr & "沒找到" '彈出警告視窗
End With
End Sub

複製代碼

Hsieh 大大目前應用正確了
這是我目前自己寫的注解不知道是不是正確..
另外想請問一下
為什麼要先讀入全部的Sheet2的欄位，若Sheet2有好幾萬筆的時候有沒有效能問題呀?
處理過程中有把變數拆開 Split 又組合 Join 我不是很了解那些
有沒有什麼辦法可以看到d(A.Value) 的值是怎麼變化的呢?

(我真的是超超超新手，旁邊的不要笑

)

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

10^#

發表於 2010-6-12 20:52 | 只看該作者

回復 9# milkpillow

試試看是不是這樣的意思

Sub matchdata()
Dim Ay()
Set d = CreateObject("Scripting.Dictionary")
With Sheet2
For Each A In .Range(.[A2], .[A65536].End(xlUp))
If d.exists(A.Value) = False Then
d(A.Value) = Join(Array(A, A.Offset(, 1), A.Offset(, 2), A.Offset(, 3)), ",")
Else
d(A.Value) = d(A.Value) & ";" & Join(Array(A, A.Offset(, 1), A.Offset(, 2), A.Offset(, 3)), ",")
End If
Next
End With
With Sheet1
For Each A In .Range(.[C2], .[C65536].End(xlUp))
If d.exists(A.Value) = True Then
Ar = Split(d(A.Value), ";")
For i = 0 To UBound(Ar)
ReDim Preserve Ay(s)
Ay(s) = Split(A.Offset(, -2) & "," & A.Offset(, -1) & "," & Ar(i), ",")
s = s + 1
Next
Else
If mystr = "" Then mystr = A Else mystr = mystr & "," & A
End If
Next
End With
With Sheet3
.[A2:F65536] = ""
.[A2].Resize(s, 6) = Application.Transpose(Application.Transpose(Ay))
MsgBox mystr & "沒找到"
End With
End Sub

複製代碼

學海無涯_不恥下問

帖子: 10
主題: 2
精華: 0
積分: 19
點名: 0
作業系統: windows
軟體版本: office 2007
閱讀權限: 10
註冊時間: 2010-5-29
最後登錄: 2011-10-12

論壇贊助勳章

9^#

發表於 2010-6-11 17:00 | 只看該作者

本帖最後由 milkpillow 於 2010-6-12 16:15 編輯

我將檔案全部整理成口語話的欄位名稱
並且刪去沒有用到的.
加上了箭頭跟顏色說明
希望這樣可以比較好理解...
勞煩了謝謝您～

如附件

QQ2.zip (24.84 KB)

沒有做什麼的編輯只是沒有人看見我..

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

8^#

發表於 2010-6-11 11:28 | 只看該作者

回復 7# milkpillow

A收集的品名跟B全部資料的OS_NAME有甚麼關連對應索引?
或是確定數量會相同?

學海無涯_不恥下問

帖子: 10
主題: 2
精華: 0
積分: 19
點名: 0
作業系統: windows
軟體版本: office 2007
閱讀權限: 10
註冊時間: 2010-5-29
最後登錄: 2011-10-12

論壇贊助勳章

7^#

發表於 2010-6-10 23:29 | 只看該作者

Hsieh 大

這個是製造新商品選項用的SQL用的..
有袖女上衣有長T 短T 但是各有白色粉紅藍色，另外一個情況則背心A 只有黃色黑色.
那麼各種商品有的顏色並不一定.
目前做的是從舊的型號去取得這個商品有什麼色的選項.(就是A收集的C欄位對應 B全部紀錄得出多列可用資料)
並將產生的新的選項塞到資料庫中.
那麼在實際應用上面每個新商品都至少會有一個選項(集).

所以目前的問題是. (下面敘述請查看上面的附檔QQ)
新型號A01~A05 都需要同一個顏色選項集555.(該集合有1、5、6、18、25、30、75的顏色)
但是他只會抓到A01 的顏色選項集555
實際上A02~A05 應該要分別產生出顏色選項集555.(該集合有1、5、6、18、25、30、75的顏色)
↑因為他們擁有相同的顏色集555

請您再幫我費神一下謝先

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

6^#

發表於 2010-6-10 23:02 | 只看該作者

回復 5# milkpillow

這樣2個表的關聯性不足
並不知道每筆確定的比對對象
請說明2表資料的比對規則
重新思考邏輯

學海無涯_不恥下問

帖子: 10
主題: 2
精華: 0
積分: 19
點名: 0
作業系統: windows
軟體版本: office 2007
閱讀權限: 10
註冊時間: 2010-5-29
最後登錄: 2011-10-12

論壇贊助勳章

5^#

發表於 2010-6-10 12:26 | 只看該作者

本帖最後由 milkpillow 於 2010-6-10 12:48 編輯

請教 Hsieh 與各位前輩.
實際應用後發現重複的值他不會處理出來.(如附件)
我看了幾個小時實在是不甚了解...

Sub AA_Table()
Dim A As Range, C As Range, Ar() //定義變數
With Sheets("B全部紀錄")    //用B表
For Each A In .Range(.[A2], .[A1048576].End(xlUp)) //A欄逐列處理
Set C = Sheets("A收集").Columns("C").Find(A, lookat:=xlWhole) //在A收集的c欄尋找A . 是不是這邊應該要反過來寫  在B全部紀錄A欄尋找A?
   If Not C Is Nothing Then
   ReDim Preserve Ar(s)
   Ar(s) = Array(C.Offset(, -2).Value, C.Offset(, -1).Value, A.Offset(, 1).Value, A.Offset(, 2).Value, A.Offset(, 3).Value) //設定 C輸出五欄的值
   s = s + 1
End If
Next
End With
Sheets("C輸出").[A2:E1048576].Clear
If s > 0 Then Sheets("C輸出").[A2].Resize(s, 5) = Application.Transpose(Application.Transpose(Ar))
Sheets("C輸出").Select
End Sub

QQ.zip (21.6 KB)

帖子: 10
主題: 2
精華: 0
積分: 19
點名: 0
作業系統: windows
軟體版本: office 2007
閱讀權限: 10
註冊時間: 2010-5-29
最後登錄: 2011-10-12

論壇贊助勳章

4^#

發表於 2010-5-29 17:34 | 只看該作者

我已下載測試完全符合要輸出的結果
而且好方便瞬間減少我的笨方法手動迴圈所耗費的時間與力氣...
突然覺得我好渺小... 這動作至少浪費我生命中的整整240個小時有..

這麼顯著的減少手動操作..
讓小妹對於VBA更有興趣了..
雖然很多指令不了解我太淺了...但是我會去查的..
先感謝兩位大大的回覆..

網路上有這個論壇真好~
世界上有兩位前輩真好~