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

maiko

中學生 Rank: 2

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

11^# 跳轉到 »

發表於 2012-9-25 11:33 | 只看該作者

大大，能否幫我看看，謝謝！

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

12^#

發表於 2012-9-25 15:09 | 只看該作者

回復 11# maiko

在Sheet2中的B、C欄隨便打個資料看看

學海無涯_不恥下問

TOP

maiko

中學生 Rank: 2

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

13^#

發表於 2012-9-26 10:22 | 只看該作者

回復 maiko

在Sheet2中的B、C欄隨便打個資料看看
Hsieh 發表於 2012-9-25 15:09

果然可以啦！
不過能否把清單的順序排為升序嗎？謝謝！

TOP

maiko

中學生 Rank: 2

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

14^#

發表於 2012-9-26 11:15 | 只看該作者

回復 maiko

在Sheet2中的B、C欄隨便打個資料看看
Hsieh 發表於 2012-9-25 15:09

補充一下：
能否通過Sheet1表中的A2、B2、C2儲存格的改變而令到D2、E2儲存格的清單改變？謝謝！

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

15^#

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

回復 14# maiko

Book3_New.rar (26.71 KB)
sheet1模組

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, [A2:C2]) Is Nothing Then CreateList
Application.EnableEvents = True
End Sub

複製代碼

一般模組

Sub Search_Data_New()
Application.ScreenUpdating = False
Application.EnableEvents = False
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
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Sub CreateList()
Dim A As Range
Set dic = CreateObject("Scripting.Dictionary")
Set dic1 = CreateObject("Scripting.Dictionary")
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
.[F1:G1] = .[B1:C1].Value
.Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Sheet1.[A1:C2], .[F1:G1], True
r = .Range("F1").CurrentRegion.Rows.Count
With .Range(.[F1], .[F1].End(xlDown))
.Sort key1:=.Cells(1, 1), Header:=xlYes
If r > 1 Then
For Each A In .Cells(1).Offset(1).Resize(.Count - 1, 1)
dic(A.Value) = ""
Next
End If
.Clear
End With
With .Range(.[G1], .[G1].End(xlDown))
.Sort key1:=.Cells(1, 1), Header:=xlYes
If r > 1 Then
For Each A In .Cells(1).Offset(1).Resize(.Count - 1, 1)
dic1(A.Value) = ""
Next
End If
.Clear
End With
End With
With .Range("D2").Validation
.Delete
If r > 1 Then .Add xlValidateList, , , Join(dic.keys, ",")
End With
With .Range("E2").Validation
.Delete
If r > 1 Then .Add xlValidateList, , , Join(dic1.keys, ",")
End With
.[A2] = y
.[B2] = m
.[C2] = d
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

maiko

中學生 Rank: 2

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

16^#

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

回復 maiko

sheet1模組一般模組
Hsieh 發表於 2012-9-26 20:41

大大，真是感謝你的幫忙，試過代碼，還真行！

不過還有一點點錯誤，大大能否幫忙改一下，就是，如果在選定了A2、B2、C2之後，如果D2也選定的話，那麼E2能否隨著D2的選擇而出現對應的清單內容？

感謝！

TOP

maiko

中學生 Rank: 2

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

17^#

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

回復 maiko

sheet1模組一般模組
Hsieh 發表於 2012-9-26 20:41

我覺得好像要求越來越多似的，我有點覺得不好意思，不過還剩下一點點東西要大大再幫幫忙，就這麼一點點東西了，如果弄好那就完美了，不知道大大能否再動手幫忙修改一下，真是感激不盡！

就是能否把A2、B2、C2也改成數據庫裡存在的日期清單？
選定了A2，那麼B2、C2、D2、E2也就跟著改變清單內容；
選定了A2、B2，那麼C2、D2、E2也就跟著改變清單內容；
如此類推，如果選定了某兩個或者三個的話，那麼其餘的也跟隨改變清單內容；
就是這麼的一個交叉查詢、互為改變的一個聯級清單，搞定了，那麼這個數據庫就完成了。

感激大大的盛情幫忙！在此拜謝！千萬別嫌在下麻煩。感謝！

TOP

maiko

中學生 Rank: 2

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

18^#

發表於 2012-9-28 11:56 | 只看該作者

請大大幫幫忙，拜託一下，拜謝了!

TOP

maiko

中學生 Rank: 2

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

19^#

發表於 2012-9-29 06:29 | 只看該作者

回復 maiko

sheet1模組一般模組
Hsieh 發表於 2012-9-26 20:41

Hsieh大，請你一定要幫忙修改一下，麻煩你了。

請把A2、B2、C2也改成數據庫裡存在的日期清單？
選定了A2，那麼B2、C2、D2、E2也就跟著改變清單內容；
選定了A2、B2，那麼C2、D2、E2也就跟著改變清單內容；
餘此類推，如果選定了某兩個或者三個的話，那麼其餘的也跟隨改變清單內容；
就是這麼的一個交叉查詢、互為改變的一個聯級清單。

TOP

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]