標題:
[發問]
多張工作表查詢資料
[打印本頁]
作者:
shootingstar
時間:
2011-3-14 01:27
標題:
多張工作表查詢資料
用EXCEL建了一張銷售資料表，裡面為按月份建立明細，希望在查詢工作表內的B1欄輸入欲查詢的客戶如"A"，可在各個月份的銷售表裡將銷售明細複製到查詢表裡A3儲存格，目前的能力只會利用進階篩選將要查詢的資料篩選到同一張工作表，無法進行多張工作表的篩選及複製到其他工作表，範例如附件，謝謝。[attach]4983[/attach]
作者:
GBKEE
時間:
2011-3-14 14:49
本帖最後由 GBKEE 於 2011-3-14 14:51 編輯
回復
1#
shootingstar
建議所有資料置於同一工作表
進階篩選[attach]4996[/attach]
作者:
shootingstar
時間:
2011-3-15 12:10
謝謝donald及GBKEE的指導，不過老闆堅持按月份建檔，所以無法把所有資料建置於同一工作表，如果是將所以資料建於同一作表，那是不是就簡單多了，只要用自動篩選就可以得到想要的答案，還是有沒注意到的地方？
想請教donald前輩，如果我資料是從A到L欄、查詢出來的結果要從A5儲存格貼起，我是不是將第16行的程式碼改為[a5:l1000] = ""，第17行的程式碼改為[a5].Resize(j, 12) = Application.Transpose(Application.Transpose(dic.items))，可是在執行後就一直出現錯誤，偵錯結果是第17行出了問題，請教是那邊有誤？另外樞紐分析表也是有達到我要的結果，不過我從昨天一直試到現在，關於VBA跟樞紐分析表我都做不出來，希望能得到進一步解說，謝謝。
作者:
GBKEE
時間:
2011-3-15 16:40
回復
5#
shootingstar
請附檔上來. 才會看清楚錯誤在哪裡.
1樓的另一解法
Private Sub CommandButton1_Click()
Dim S As Worksheet, Rng As Range, R As Range
With Sheets("查詢表")
.Range("a4").CurrentRegion.Offset(1).Clear
For Each S In Sheets
If S.Name Like "*月" Then
Set Rng = Nothing
For Each R In S.UsedRange.Rows
If R.Cells(1, 2) = .[b1] Then
If Rng Is Nothing Then Set Rng = R Else Set Rng = Union(Rng, R)
End If
Next
End If
If Not Rng Is Nothing Then Rng.Copy .Range("A" & Rows.Count).End(xlUp).Offset(1)
Next
End With
End Sub
複製代碼
作者:
shootingstar
時間:
2011-7-13 11:45
將程式碼複製使用後，縮短了查詢時間，不過老闆又提出能否改進查詢功能設定，例如客戶名稱是"ABCD"，那不論我輸入"ABCD"或是"abcd"或"AB"又或著"ab"，都能查詢到"ABCD這家客戶。尋求解答，謝謝。
作者:
GBKEE
時間:
2011-7-13 14:55
回復
5#
shootingstar
請下載2樓檔案 將資料庫客戶 修改為你所希望的 , 再到查詢表 客戶 輸入
*
ABCD
*
或
*
abcd
*
或
*
AB
*
或
*
ab
*
試試看
作者:
Hsieh
時間:
2011-7-13 15:07
回復
5#
shootingstar
進階篩選
[attach]6996[/attach]
作者:
shootingstar
時間:
2011-7-13 16:17
我要發揮"學海無涯_不恥下問"的精神，關於Hsieh版主的回覆，程式碼我幾乎都看不懂。因為不懂程式碼的意義，我自己做了修改碼套用在自己的檔案裡，是不成功的，先將我使用的檔案附上，尋求解答，問題同原始發問，希望輸入"ABC"或"abc"都可以找到"ABC"這個客戶，或是輸入"台積電"或"台積"都可以找到"台積電"這家客戶，以上，再次謝謝前輩的回覆。
作者:
Hsieh
時間:
2011-7-13 17:41
Sub Ex()
Dim Ar()
With Sheets("查詢")
test = UCase(.[B1])
For Each sh In Sheets
If sh.Name Like "*月" Then
With sh.Range("A1").CurrentRegion
For i = 2 To .Rows.Count
If InStr(UCase(.Cells(i, 1)), test) > 0 Then
ReDim Preserve Ar(s)
Ar(s) = .Rows(i)
s = s + 1
End If
Next
End With
End If
Next
.[A5].CurrentRegion.Offset(1) = ""
If s > 0 Then
.[A5].Resize(s, 9) = Application.Transpose(Application.Transpose(Ar))
Else
MsgBox "無符合資料"
End If
End With
End Sub
複製代碼
回復
8#
shootingstar
作者:
wopeter1234
時間:
2013-2-4 20:33
好多好用的程式，下載來看看.............................................................................
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)
