maiko

帖子: 95
主題: 28
精華: 0
積分: 127
點名: 0
作業系統: win
軟體版本: 7
閱讀權限: 20
註冊時間: 2011-3-8
最後登錄: 2024-4-1

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2012-9-18 17:05 | 只看該作者

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

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

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

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

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

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

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

7. 2012年全年總金額。

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

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

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

樓主熱帖

maiko

中學生 Rank: 2

帖子: 95
主題: 28
精華: 0
積分: 127
點名: 0
作業系統: win
軟體版本: 7
閱讀權限: 20
註冊時間: 2011-3-8
最後登錄: 2024-4-1

2^#

發表於 2012-9-18 17:08 | 只看該作者

回復 1# maiko

補上附件

Book3.zip (9.08 KB)

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

3^#

發表於 2012-9-18 20:16 | 只看該作者

回復 2# maiko

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

複製代碼

學海無涯_不恥下問

TOP

maiko

中學生 Rank: 2

帖子: 95
主題: 28
精華: 0
積分: 127
點名: 0
作業系統: win
軟體版本: 7
閱讀權限: 20
註冊時間: 2011-3-8
最後登錄: 2024-4-1

4^#

發表於 2012-9-19 08:15 | 只看該作者

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

TOP

maiko

中學生 Rank: 2

帖子: 95
主題: 28
精華: 0
積分: 127
點名: 0
作業系統: win
軟體版本: 7
閱讀權限: 20
註冊時間: 2011-3-8
最後登錄: 2024-4-1

5^#

發表於 2012-9-19 08:18 | 只看該作者

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

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

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

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

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

6^#

發表於 2012-9-19 09:27 | 只看該作者

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

Sub Search_Data()
With Sheet1
y = .[A2]: m = .[B2]: d = .[C2]
.[A2] = IIf(.[A2] = "", "", "=YEAR(Sheet2!A2)=" & y)
.[B2] = IIf(.[B2] = "", "", "=MONTH(Sheet2!A2)=" & m)
.[C2] = IIf(.[C2] = "", "", "=DAY(Sheet2!A2)=" & d)
With Sheet2
.Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Sheet1.[A1:E2], Sheet1.[A6:D6], False
End With
If .[A7] = "" Then
MsgBox "無資料"
Else
.Cells(.Rows.Count, 3).End(xlUp).Offset(2).Resize(, 2) = Array("總共:", "=SUM(R7C:R[-1]C)")
End If
.[A2] = y
.[B2] = m
.[C2] = d
End With
End Sub

複製代碼

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

Private Sub Worksheet_Change(ByVal Target As Range)
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
If Target.Column = 2 Or Target.Column = 3 Then
For Each a In Range([B2], Cells(Rows.Count, 2).End(xlUp)).SpecialCells(xlCellTypeConstants)
d(a.Value) = ""
d1(a.Offset(, 1).Value) = ""
Next
With Sheet1
With .Range("D2").Validation
.Delete
.Add xlValidateList, , , Join(d.keys, ",")
End With
With .Range("E2").Validation
.Delete
.Add xlValidateList, , , Join(d1.keys, ",")
End With
End With
End If
End Sub

複製代碼

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

學海無涯_不恥下問

TOP

maiko

中學生 Rank: 2

帖子: 95
主題: 28
精華: 0
積分: 127
點名: 0
作業系統: win
軟體版本: 7
閱讀權限: 20
註冊時間: 2011-3-8
最後登錄: 2024-4-1

7^#

發表於 2012-9-20 10:11 | 只看該作者

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

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

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

TOP

maiko

中學生 Rank: 2

帖子: 95
主題: 28
精華: 0
積分: 127
點名: 0
作業系統: win
軟體版本: 7
閱讀權限: 20
註冊時間: 2011-3-8
最後登錄: 2024-4-1

8^#

發表於 2012-9-20 16:26 | 只看該作者

回復 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)

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

9^#

發表於 2012-9-20 19:35 | 只看該作者

回復 8# maiko

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

學海無涯_不恥下問

TOP

maiko

中學生 Rank: 2

帖子: 95
主題: 28
精華: 0
積分: 127
點名: 0
作業系統: win
軟體版本: 7
閱讀權限: 20
註冊時間: 2011-3-8
最後登錄: 2024-4-1

10^#

發表於 2012-9-24 10:28 | 只看該作者

回復 maiko

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

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

Book3_New.zip (21.64 KB)

TOP