[求助] 請高手求助，如何用vba查找資料庫中的資料記錄？

maiko

下載 (11.99 KB)

2012-9-18 17:01

1. 客戶：h001，品名：b2，歷年來的總金額。

下載 (15.2 KB)

2012-9-18 17:01

2. 客戶：h001，歷年來的總金額。

下載 (10.4 KB)

2012-9-18 17:01

3. 應該是2012年8月份，客戶：h001，品名：b2，總金額。

下載 (11.18 KB)

2012-9-18 17:01

4. 應該是2012年8月份，客戶：h001，總金額。

下載 (13.41 KB)

2012-9-18 17:01

5. 應該是2012年8月份，品名：a1，總金額。

下載 (18.73 KB)

2012-9-18 17:02

6. 應該是2012年8月份，總金額。

下載 (22.9 KB)

2012-9-18 17:02

7. 2012年全年總金額。

下載 (11.67 KB)

2012-9-18 17:02

8. 2012年，客戶：h001，全年總金額。

下載 (9.28 KB)

2012-9-18 17:02

9. 2012年，客戶：h001，品名：a1，全年總金額。

這樣的一個交叉查詢資料庫，請問用vba如何實現？感激各位賜教。

maiko

回復 1# maiko


補上附件
Book3.zip (9.08 KB)

下載次數: 16

2012-9-18 17:08

Hsieh

回復 2# maiko

1. Sub Search_Data()
   
2. d = [A2]
   
3. [A2] = IIf([A2] >= 1 And [A2] <= 12, "=MONTH(Sheet2!A2)=" & d, IIf(d = "", "", "=YEAR(Sheet2!A2)=" & d))
   
4. [A1] = IIf([A2] <> "", "", "日期")
   
5. With Sheet2
   
6. .Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Sheet1.[A1:C2], Sheet1.[A6:D6], False
   
7. End With
   
8. Cells(Rows.Count, 3).End(xlUp).Offset(2).Resize(, 2) = Array("總共:", "=SUM(R7C:R[-1]C)")
   
9. [A2] = d
   
10. [A1] = "日期"
    
11. End Sub

複製代碼

maiko

可惜不夠積分，不能下載！

maiko

回復  maiko
Hsieh 發表於 2012-9-18 20:16

   

下載 (8.13 KB)

2012-9-19 08:16

剛剛發現一個問題，就是應該把日期的年月日分開來查詢，這樣才能夠準確一點，能否改成如果只輸入年，月日不輸入的話就查詢整年的資料，年月同時輸入的話就查詢當年當月的資料，年月日就指定這天查詢的資料，其它客戶、品名沒變。看看能否改一改？謝謝！

能否用vba作一個從Sheet2數據庫裡查詢不重複的客戶名、品名的下拉列表，可讓使用者容易的選擇客戶名、品名，不至於打錯字。謝謝！

最後，能否加一條，如果查詢不到資料，就提供使用者沒此資料？謝謝！

Hsieh

回復 5# maiko
進階查詢，在一般模組

1. Sub Search_Data()
   
2. With Sheet1
   
3.   y = .[A2]: m = .[B2]: d = .[C2]
   
4.   .[A2] = IIf(.[A2] = "", "", "=YEAR(Sheet2!A2)=" & y)
   
5.   .[B2] = IIf(.[B2] = "", "", "=MONTH(Sheet2!A2)=" & m)
   
6.   .[C2] = IIf(.[C2] = "", "", "=DAY(Sheet2!A2)=" & d)
   
7. With Sheet2
   
8.    .Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Sheet1.[A1:E2], Sheet1.[A6:D6], False
   
9. End With
   
10. If .[A7] = "" Then
    
11.   MsgBox "無資料"
    
12. Else
    
13.   .Cells(.Rows.Count, 3).End(xlUp).Offset(2).Resize(, 2) = Array("總共:", "=SUM(R7C:R[-1]C)")
    
14. End If
    
15.   .[A2] = y
    
16.   .[B2] = m
    
17.   .[C2] = d
    
18. End With
    
19. End Sub

複製代碼

取得Sheet2工作表B、C欄不重複清單做為驗證清單
Sheet2工作表模組

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Set d1 = CreateObject("Scripting.Dictionary")
   
4. If Target.Column = 2 Or Target.Column = 3 Then
   
5. For Each a In Range([B2], Cells(Rows.Count, 2).End(xlUp)).SpecialCells(xlCellTypeConstants)
   
6. d(a.Value) = ""
   
7. d1(a.Offset(, 1).Value) = ""
   
8. Next
   
9. With Sheet1
   
10.   With .Range("D2").Validation
    
11.   .Delete
    
12.   .Add xlValidateList, , , Join(d.keys, ",")
    
13.   End With
    
14.   With .Range("E2").Validation
    
15.   .Delete
    
16.   .Add xlValidateList, , , Join(d1.keys, ",")
    
17.   End With
    
18. End With
    
19. End If
    
20. End Sub

複製代碼

Sheet2工作表B、C欄有變動時，Sheet1工作表[D2]、[E2]的驗證清單就會改變

maiko

回復  maiko
進階查詢，在一般模組取得Sheet2工作表B、C欄不重複清單做為驗證清單
Sheet2工作表模組Shee ...
Hsieh 發表於 2012-9-19 09:27

    謝謝大大提供這麼好的vba語言，只是分數太低，無法下載原件測試，只好拿大大的vba去慢慢啄磨，謝謝！

如遇有什麼問題，容後再提，可以嗎？謝謝！

maiko

回復  maiko
進階查詢，在一般模組取得Sheet2工作表B、C欄不重複清單做為驗證清單
Sheet2工作表模組Shee ...
Hsieh 發表於 2012-9-19 09:27

    在試過以Sheet2查詢不重複清單時，Sheet1的A2，B2，C2，D2，E2儲存格只有D2，E2出現清單，其它沒出現，而且D2，E2出現的清單並不是以Sheet2表中查詢的不重複清單，請查看附件是否有沒錯?謝謝！

Book3_New.zip (20.75 KB)

下載次數: 8

2012-9-20 16:25

Hsieh

回復 8# maiko


    你把代碼放錯工作表模組
要放在Sheet2工作表模組內
然後變動B、C欄資料
只有D2、E2有驗證，是因為進階篩選準則範圍目前只有A1:E2
其他部分並不需要驗證清單，若你有需求只要把範圍改一下就好

maiko

回復  maiko


    你把代碼放錯工作表模組
要放在Sheet2工作表模組內
然後變動B、C欄資料
只有D2、 ...
Hsieh 發表於 2012-9-20 19:35

   
你好，我把代碼放在Sheet2工作表模組內，然後變動B、C欄，可是還是無法驗證出D、E欄的資料，請查一查附件。
由於無法下載大大提供的附件，請幫忙看看，謝謝！

Book3_New.zip (21.64 KB)

下載次數: 15

2012-9-24 10:28