麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 根據多條件篩選清單 [打印本頁]

作者: maiko 時間: 2015-4-17 17:05 標題: 根據多條件篩選清單

[attach]20688[/attach]

1. 根據 Shop 和 Code 篩選有關 Date 的所有清單。
2. 查出了 Date 的所有清單後，選擇其中一個日期而找出 Amount 金額。
謝謝！

[attach]20689[/attach]

作者: lpk187 時間: 2015-4-17 18:16

回復 1# maiko

剛不久前，我作了一個類似的，修改了一下，也不知是不是應你的要求！

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = [k3].Address Then
Range("B2:G" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter
ActiveWorkbook.Worksheets("工作表1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("工作表1").AutoFilter.Sort.SortFields.Add Key:=Range( _
"B2:B" & Cells(Rows.Count, 2).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("工作表1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B2:G" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter
shop = [k3]
For Each Rng In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
If Rng = shop Then
K = K + 1
If K = 1 Then
Set Rn = Rng.Offset(0, 1)
Else
Set Rn = Union(Rn, Rng.Offset(0, 1))
End If
End If
Next
aa = Rn.Address
If aa = "" Then
Exit Sub
Else
With [L3].Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & aa
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = False
End With
End If
[L3] = "請選擇日期"
End If
If Target.Address = [L3].Address Then
For Each Rang In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
If Rang = [k3] And Rang.Offset(0, 1) = [L3] Then
[K5] = Rang.Offset(0, 2)
[L5] = Rang.Offset(0, 5)
End
End If
Next
End If
End Sub

複製代碼

作者: lpk187 時間: 2015-4-17 18:19

回復 1# maiko

順便提一下，資料驗證清單必須是連續的儲存格，所以我程序中有做排序的動作

作者: maiko 時間: 2015-4-17 19:10

回復 maiko

剛不久前，我作了一個類似的，修改了一下，也不知是不是應你的要求！
lpk187 發表於 2015-4-17 18:16

我放了這段編碼，可是沒反應，不知道是哪裡有問題?

作者: lpk187 時間: 2015-4-17 19:40

回復 4# maiko

這是工作表的事件程序，所以你必須貼在工作表1的程序中

作者: lpk187 時間: 2015-4-17 19:48

本帖最後由 lpk187 於 2015-4-17 19:51 編輯

回復 4# maiko
在工作表1的標籤上按右鍵選擇檢視程式碼
[attach]20698[/attach]
然後在編輯區貼上代碼就行了
[attach]20699[/attach]
1。貼上後，只要你在"K3"儲存格鍵入你的shop，日期欄的清單就會改變，
2。改變日期清單後，只要你改變日期清單的資料，就會得到你要的答案

作者: lpk187 時間: 2015-4-17 19:53

回復 4# maiko

[attach]20700[/attach]

作者: maiko 時間: 2015-4-18 07:51

回復 maiko
lpk187 發表於 2015-4-17 19:53

不好意思，我的原意是先有 Shop 和 Code 這兩個條件，然後篩選出 Date，有了 Date 之後才有 Amount，謝謝！

作者: lpk187 時間: 2015-4-18 08:43

回復 8# maiko

不好意思，誤會你的意思，不過你仍可以修改其中的判斷就可以達到你要的東西了！

作者: maiko 時間: 2015-4-18 12:42

回復 maiko

不好意思，誤會你的意思，不過你仍可以修改其中的判斷就可以達到你要的東西了！
lpk187 發表於 2015-4-18 08:43

好吧，試試看，有不明白再問你，好嗎?

作者: maiko 時間: 2015-4-18 16:03

回復 maiko

不好意思，誤會你的意思，不過你仍可以修改其中的判斷就可以達到你要的東西了！
lpk187 發表於 2015-4-18 08:43

不好意思，真的是能力有限，不知道從哪裡改，麻煩你賜教賜教，感謝！

作者: tyrone123456 時間: 2015-4-18 16:56

Excel寫法如圖，只要篩選H欄就可以看到所有資料了

[attach]20708[/attach]

作者: lpk187 時間: 2015-4-18 18:26

本帖最後由 lpk187 於 2015-4-18 18:27 編輯

回復 11# maiko

要查看工作表事件的逐行"F8"鍵，須先在第一行執行中斷"F9"會比較容易觀察逐行執行時相關的區域變數視窗，
下面是我修改過的程式碼，我有用^^^^^^^標誌是修正原來你要的東西，就像我說的只要修改其中的判斷就可以達到你要的目標，
還有這裡是討論區，不是你要程式的地方，所以希望你可以從程式碼中學到東西！

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = [k5].Address Then
'''''''''''''''''''''''''''''^^^^
      Range("B2:G" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter
      ActiveWorkbook.Worksheets("工作表1").AutoFilter.Sort.SortFields.Clear
      ActiveWorkbook.Worksheets("工作表1").AutoFilter.Sort.SortFields.Add Key:=Range( _
         "B2:B" & Cells(Rows.Count, 2).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
         xlSortNormal
      With ActiveWorkbook.Worksheets("工作表1").AutoFilter.Sort
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
      End With
      Range("B2:G" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter

shop = [k3]
Code = [k5]
'^^^^^^^^^^^^^^
For Each Rng In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
      If Rng = shop And Rng.Offset(0, 2) = Code Then
      '''''''''''''''''''''''''''''''''''^^^^^^^^^^^^^^^'
         K = K + 1
         If K = 1 Then
            Set Rn = Rng.Offset(0, 1)
         Else
            Set Rn = Union(Rn, Rng.Offset(0, 1))
         End If
      End If
Next
aa = Rn.Address
If aa = "" Then
      Exit Sub
Else
      With [L3].Validation
         .Delete
         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & aa
         .IgnoreBlank = True
         .InCellDropdown = True
         .InputTitle = ""
         .ErrorTitle = ""
         .InputMessage = ""
         .ErrorMessage = ""
         .IMEMode = xlIMEModeNoControl
         .ShowInput = True
         .ShowError = False
      End With
End If
[L3].Select
'^^^^^^^^^^
[L3] = "請選擇日期"

End If
If Target.Address = [L3].Address Then
If [L3] = "請選擇日期" Then End
For Each Rang In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
      If Rang = [k3] And Rang.Offset(0, 1) = [L3] And Rang.Offset(0, 2) = [k5] Then
         [L5] = Rang.Offset(0, 5) '''''''''''''''''''''''''''''''''''''''''^^^^^^^^^^^^^^'
         End
      End If
Next
End If
End Sub

作者: maiko 時間: 2015-4-22 05:33

回復 13# lpk187

總是到了這句： .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & aa
就出現錯誤，無法進行。

不過Google上了解了一些資料，竟然發覺都沒有下拉選單不重複值並且排序這方面的程式碼，只好用自己的土辦法去完成這個功能，我想這裡也應該沒有這方面的參考吧。

作者: lpk187 時間: 2015-4-22 07:07

回復 lpk187

總是到了這句： .Add Type:=xlValidateList, AlertStyle:=xlValidAler ...
maiko 發表於 2015-4-22 05:33

這個討論區隨便找都有你要的程式碼，隨便組一組都可以達到你要的目標，看你要不要用心而已！
還有若是程式不能執行，或是你自已不會除錯，最好上傳你的原檔案上來，自有人幫你修正的！

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)