12
返回列表 上一主題 發帖

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

milkpillow

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

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2010-5-29 06:52 | 只看該作者

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

本帖最後由 milkpillow 於 2010-6-14 23:54 編輯

各位前輩
這個標題想了十分鍾有... 不是很確切.請見諒~_~

A表 有很多筆資料 ID 是不重複的
B表 有很多筆資料 SID 會重複 但是值不會重複 (好像也不對... 應該是 ID+值 不會重複)
C表 是要輸出結果樣子 (我都用手做 一百筆資料就要兩小時...)

我手動的操作方式：
A表的第一筆資料 的 ST欄 複製該值
切換B表 使用進階篩選功能 得出三筆可用資料 (這個幾筆並不固定，基本上應該至少有一筆...)
切換C表 將三筆可用資料 複製到C表貼上 並且把A表的ID 跟PAGE資訊也複製過去
回A表的第二筆資料再繼續複製..
手動迴圈兩個鐘頭之後 一百筆完成...

真的很難用國語敘述... 而且做起來很費時間..
我準備了一個檔案 請前輩們指點一下.. 裡面我有寫註解..怕不明顯 所以用顯示 可能會礙眼..

我用網路查到 舊網站有篇文章很像有關係 但已經無法註冊跟觀看.. >"<
http://gb.twbts.com/index.php?topic=12801.0

以上 麻煩您(s)了

pro.zip (12 KB)

收藏 分享

PD961A

帖子
1180 
主題
204 
精華
0 
積分
1051 
點名
0  
作業系統
Mac.OS10.6 
軟體版本
Office 2003 
閱讀權限
100 
性別
男 
註冊時間
2010-5-3 
最後登錄
2012-9-19 

2012龍年全勤獎章論壇貢獻勳章終身榮譽會員勳章好學求知勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2010-5-29 08:44 | 只看該作者
回復 1# milkpillow

     http://gb.twbts.com/index.php?topic=12801.0
    主題: sheet2內容固定,比對sheet1後,將符合的列複製於sheet3  

  Hsieh版主   Re: sheet2內容固定,比對sheet1後,將符合的列複製於sheet3
&laquo; 回覆文章 #9 於: 2010-02-28, 18:07:56 &raquo;  
程式碼:
Sub nn()
Dim Rng As Range, A As Range, Cell As Range
With Sheet2
Set Rng = .Range(.[A1], .[A65536].End(xlUp))'設置比對的標準區域
End With
With Sheet1
For Each A In .Range(.[D1], .[D65536].End(xlUp))'在sheet1的d欄資料循環
　　If Not Rng.Find(A, lookat:=xlWhole) Is Nothing Then'如果標準區找到d欄的值
　　　 If Cell Is Nothing Then Set Cell = A Else Set Cell = Union(Cell, A)'如果變數Cell是不是物件就將d欄設給Cell否則Cell就會將原來範圍增加一儲存格A
　　End If
Next
End With
Sheet3.Cells = ""'清空Sheet3內容
Cell.EntireRow.Copy Sheet3.[A1]'把Sheet1符合的列複製到Sheet3的A1
　　　
End Sub

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 2010-5-29 09:01 | 只看該作者
回復 1# milkpillow
  1. Sub Q_Table()
  2. Dim A As Range, C As Range, Ar()
  3. With Sheets("B全部紀錄")
  4. For Each A In .Range(.[A2], .[A1048576].End(xlUp))
  5.    Set C = Sheets("A收集").Columns("C").Find(A, lookat:=xlWhole)
  6.      If Not C Is Nothing Then
  7.        ReDim Preserve Ar(s)
  8.        Ar(s) = Array(C.Offset(, -2).Value, C.Offset(, -1).Value, A.Offset(, 1).Value, A.Offset(, 2).Value, A.Offset(, 3).Value)
  9.        s = s + 1
  10.    End If
  11. Next
  12. End With
  13. Sheets("C輸出").[A2:E1048576].Clear
  14. If s > 0 Then Sheets("C輸出").[A2].Resize(s, 5) = Application.Transpose(Application.Transpose(Ar))
  15. Sheets("C輸出").Select
  16. End Sub
複製代碼
pro.rar (19.82 KB)
學海無涯_不恥下問

TOP

milkpillow

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

論壇贊助勳章
4#
發表於 2010-5-29 17:34 | 只看該作者
我已下載測試 完全符合要輸出的結果
而且好方便 瞬間減少我的笨方法手動迴圈 所耗費的時間與力氣...
突然覺得我好渺小... 這動作至少浪費我生命中的整整240個小時有..

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

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

TOP

milkpillow

帖子
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)

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2010-6-10 23:02 | 只看該作者
回復 5# milkpillow


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

TOP

milkpillow

帖子
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

請您再幫我費神一下 謝先

TOP

Hsieh

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

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有甚麼關連對應索引?
或是確定數量會相同?
學海無涯_不恥下問

TOP

milkpillow

帖子
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)


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

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
10#
發表於 2010-6-12 20:52 | 只看該作者
回復 9# milkpillow

試試看是不是這樣的意思
  1. Sub matchdata()
  2. Dim Ay()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheet2
  5.   For Each A In .Range(.[A2], .[A65536].End(xlUp))
  6.      If d.exists(A.Value) = False Then
  7.         d(A.Value) = Join(Array(A, A.Offset(, 1), A.Offset(, 2), A.Offset(, 3)), ",")
  8.         Else
  9.         d(A.Value) = d(A.Value) & ";" & Join(Array(A, A.Offset(, 1), A.Offset(, 2), A.Offset(, 3)), ",")
  10.      End If
  11.     Next
  12. End With
  13. With Sheet1
  14.    For Each A In .Range(.[C2], .[C65536].End(xlUp))
  15.       If d.exists(A.Value) = True Then
  16.          Ar = Split(d(A.Value), ";")
  17.          For i = 0 To UBound(Ar)
  18.          ReDim Preserve Ay(s)
  19.          Ay(s) = Split(A.Offset(, -2) & "," & A.Offset(, -1) & "," & Ar(i), ",")
  20.          s = s + 1
  21.          Next
  22.          Else
  23.          If mystr = "" Then mystr = A Else mystr = mystr & "," & A
  24.         End If
  25.     Next
  26. End With
  27. With Sheet3
  28. .[A2:F65536] = ""
  29. .[A2].Resize(s, 6) = Application.Transpose(Application.Transpose(Ay))
  30. MsgBox mystr & "沒找到"
  31. End With
  32. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 人的心地是一畦田，土地沒有播下好種子，也長不出好的果實。 -
12
返回列表 上一主題