[發問] 多張工作表查詢資料

shootingstar

用EXCEL建了一張銷售資料表，裡面為按月份建立明細，希望在查詢工作表內的B1欄輸入欲查詢的客戶如"A"，可在各個月份的銷售表裡將銷售明細複製到查詢表裡A3儲存格，目前的能力只會利用進階篩選將要查詢的資料篩選到同一張工作表，無法進行多張工作表的篩選及複製到其他工作表，範例如附件，謝謝。 銷售表.rar (2.05 KB)

下載次數: 35

2011-3-14 01:27

GBKEE

回復 1# shootingstar
建議所有資料置於同一工作表  
進階篩選 銷售表.rar (9.29 KB)

下載次數: 35

2011-3-14 14:50

shootingstar

謝謝donald及GBKEE的指導，不過老闆堅持按月份建檔，所以無法把所有資料建置於同一工作表，如果是將所以資料建於同一作表，那是不是就簡單多了，只要用自動篩選就可以得到想要的答案，還是有沒注意到的地方？
想請教donald前輩，如果我資料是從A到L欄、查詢出來的結果要從A5儲存格貼起，我是不是將第16行的程式碼改為[a5:l1000] = ""，第17行的程式碼改為[a5].Resize(j, 12) = Application.Transpose(Application.Transpose(dic.items))，可是在執行後就一直出現錯誤，偵錯結果是第17行出了問題，請教是那邊有誤？另外樞紐分析表也是有達到我要的結果，不過我從昨天一直試到現在，關於VBA跟樞紐分析表我都做不出來，希望能得到進一步解說，謝謝。

GBKEE

回復 5# shootingstar
請附檔上來. 才會看清楚錯誤在哪裡.
1樓的另一解法
   

1. Private Sub CommandButton1_Click()
   
2.     Dim S As Worksheet, Rng As Range, R As Range
   
3.     With Sheets("查詢表")
   
4.         .Range("a4").CurrentRegion.Offset(1).Clear
   
5.         For Each S In Sheets
   
6.             If S.Name Like "*月" Then
   
7.                 Set Rng = Nothing
   
8.                 For Each R In S.UsedRange.Rows
   
9.                     If R.Cells(1, 2) = .[b1] Then
   
10.                         If Rng Is Nothing Then Set Rng = R Else Set Rng = Union(Rng, R)
    
11.                     End If
    
12.                 Next
    
13.             End If
    
14.             If Not Rng Is Nothing Then Rng.Copy .Range("A" & Rows.Count).End(xlUp).Offset(1)
    
15.         Next
    
16.     End With
    
17. End Sub

複製代碼

shootingstar

將程式碼複製使用後，縮短了查詢時間，不過老闆又提出能否改進查詢功能設定，例如客戶名稱是"ABCD"，那不論我輸入"ABCD"或是"abcd"或"AB"又或著"ab"，都能查詢到"ABCD這家客戶。尋求解答，謝謝。

GBKEE

回復 5# shootingstar
請下載2樓檔案 將資料庫客戶 修改為你所希望的 , 再到查詢表   客戶 輸入     *ABCD*    或     *abcd*     或         *AB*       或        *ab*  
試試看

Hsieh

回復 5# shootingstar


    進階篩選
銷售表.zip (11.21 KB)

下載次數: 22

2011-7-13 15:07

shootingstar

我要發揮"學海無涯_不恥下問"的精神，關於Hsieh版主的回覆，程式碼我幾乎都看不懂。因為不懂程式碼的意義，我自己做了修改碼套用在自己的檔案裡，是不成功的，先將我使用的檔案附上，尋求解答，問題同原始發問，希望輸入"ABC"或"abc"都可以找到"ABC"這個客戶，或是輸入"台積電"或"台積"都可以找到"台積電"這家客戶，以上，再次謝謝前輩的回覆。

Hsieh

1. Sub Ex()
   
2. Dim Ar()
   
3. With Sheets("查詢")
   
4. test = UCase(.[B1])
   
5. For Each sh In Sheets
   
6.    If sh.Name Like "*月" Then
   
7.       With sh.Range("A1").CurrentRegion
   
8.          For i = 2 To .Rows.Count
   
9.             If InStr(UCase(.Cells(i, 1)), test) > 0 Then
   
10.                ReDim Preserve Ar(s)
    
11.                Ar(s) = .Rows(i)
    
12.                s = s + 1
    
13.             End If
    
14.          Next
    
15.       End With
    
16.     End If
    
17. Next
    
18. .[A5].CurrentRegion.Offset(1) = ""
    
19. If s > 0 Then
    
20.    .[A5].Resize(s, 9) = Application.Transpose(Application.Transpose(Ar))
    
21.    Else
    
22.    MsgBox "無符合資料"
    
23. End If
    
24. End With
    
25. End Sub

複製代碼

回復 8# shootingstar

wopeter1234

好多好用的程式，下載來看看.............................................................................