12
返回列表 上一主題 發帖

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

maiko

帖子
95 
主題
28 
精華
0 
積分
127 
點名
0  
作業系統
win 
軟體版本
7 
閱讀權限
20 
註冊時間
2011-3-8 
最後登錄
2024-4-1 
11# 跳轉到 »
發表於 2012-9-25 11:33 | 只看該作者
大大，能否幫我看看，謝謝！

TOP

Hsieh

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

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

帖子
95 
主題
28 
精華
0 
積分
127 
點名
0  
作業系統
win 
軟體版本
7 
閱讀權限
20 
註冊時間
2011-3-8 
最後登錄
2024-4-1 
13#
發表於 2012-9-26 10:22 | 只看該作者
回復  maiko

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



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

TOP

maiko

帖子
95 
主題
28 
精華
0 
積分
127 
點名
0  
作業系統
win 
軟體版本
7 
閱讀權限
20 
註冊時間
2011-3-8 
最後登錄
2024-4-1 
14#
發表於 2012-9-26 11:15 | 只看該作者
回復  maiko

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



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

TOP

Hsieh

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

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模組
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. Application.EnableEvents = False
  3. If Not Intersect(Target, [A2:C2]) Is Nothing Then CreateList
  4. Application.EnableEvents = True
  5. End Sub
複製代碼
一般模組
  1. Sub Search_Data_New()
  2. Application.ScreenUpdating = False
  3. Application.EnableEvents = False
  4. With Sheet1
  5.   y = .[A2]: m = .[B2]: d = .[C2]
  6.   .[A2] = IIf(.[A2] = "", "", "=YEAR(Sheet2!A2)=" & y)
  7.   .[B2] = IIf(.[B2] = "", "", "=MONTH(Sheet2!A2)=" & m)
  8.   .[C2] = IIf(.[C2] = "", "", "=DAY(Sheet2!A2)=" & d)

  10. With Sheet2
  11.    .Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Sheet1.[A1:E2], Sheet1.[A6:D6], False
  12. End With

  14. If .[A7] = "" Then
  15.   MsgBox "無資料"
  16. Else
  17.   .Cells(.Rows.Count, 3).End(xlUp).Offset(2).Resize(, 2) = Array("總共:", "=SUM(R7C:R[-1]C)")
  18. End If
  19.   
  20.   .[A2] = y
  21.   .[B2] = m
  22.   .[C2] = d

  24. End With
  25. Application.ScreenUpdating = True
  26. Application.EnableEvents = True
  27. End Sub
  28. Sub CreateList()
  29. Dim A As Range
  30. Set dic = CreateObject("Scripting.Dictionary")
  31. Set dic1 = CreateObject("Scripting.Dictionary")
  32. With Sheet1
  33.   y = .[A2]: m = .[B2]: d = .[C2]
  34.   .[A2] = IIf(.[A2] = "", "", "=YEAR(Sheet2!A2)=" & y)
  35.   .[B2] = IIf(.[B2] = "", "", "=MONTH(Sheet2!A2)=" & m)
  36.   .[C2] = IIf(.[C2] = "", "", "=DAY(Sheet2!A2)=" & d)

  38. With Sheet2
  39. .[F1:G1] = .[B1:C1].Value
  40.    .Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, Sheet1.[A1:C2], .[F1:G1], True
  41.    r = .Range("F1").CurrentRegion.Rows.Count
  42.    With .Range(.[F1], .[F1].End(xlDown))
  43.    .Sort key1:=.Cells(1, 1), Header:=xlYes
  44.    If r > 1 Then
  45.    For Each A In .Cells(1).Offset(1).Resize(.Count - 1, 1)
  46.       dic(A.Value) = ""
  47.    Next
  48.    End If
  49.    .Clear
  50.    End With
  51.    With .Range(.[G1], .[G1].End(xlDown))
  52.    .Sort key1:=.Cells(1, 1), Header:=xlYes
  53.    If r > 1 Then
  54.    For Each A In .Cells(1).Offset(1).Resize(.Count - 1, 1)
  55.       dic1(A.Value) = ""
  56.    Next
  57.    End If
  58.    .Clear
  59.    End With

  61. End With
  62. With .Range("D2").Validation
  63.   .Delete
  64.   If r > 1 Then .Add xlValidateList, , , Join(dic.keys, ",")
  65. End With
  66. With .Range("E2").Validation
  67.   .Delete
  68.   If r > 1 Then .Add xlValidateList, , , Join(dic1.keys, ",")
  69. End With
  70.   
  71.   .[A2] = y
  72.   .[B2] = m
  73.   .[C2] = d

  75. End With
  76. End Sub
複製代碼
學海無涯_不恥下問

TOP

maiko

帖子
95 
主題
28 
精華
0 
積分
127 
點名
0  
作業系統
win 
軟體版本
7 
閱讀權限
20 
註冊時間
2011-3-8 
最後登錄
2024-4-1 
16#
發表於 2012-9-27 09:14 | 只看該作者
回復  maiko


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



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

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

感謝！

TOP

maiko

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

帖子
95 
主題
28 
精華
0 
積分
127 
點名
0  
作業系統
win 
軟體版本
7 
閱讀權限
20 
註冊時間
2011-3-8 
最後登錄
2024-4-1 
18#
發表於 2012-9-28 11:56 | 只看該作者
請大大幫幫忙，拜託一下，拜謝了!

TOP

maiko

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

        靜思自在 : 滴水成河。粒米成蘿，勿輕己靈，勿以善小而不為。
12
返回列表 上一主題