楼主
zzmxy |
筛选要求如下图所示，需要筛选两部分内容，分别以D1和H1:H2为筛选条件，对A:C列进行筛选，并将数值从大到小排列，
筛选方法：
如D1单元格的条件，刚将B列与D1进行比较，如果B列某个单元格的值等于D1，那么就返回该单元格的下一行的记录，
如B1=D1，则A2:C2就是符合筛选要求的记录，并添加到E:G列，由于其值最小，故放置在最下边；
同理，H1:H2为筛选条件时，则比较B列相邻两个单元格的值是否同时满足，如满足，则返回其下一行的记录，如A3:C3。
---------------------------------
代码如下，主要思路：
- 通过建立字典，并对B列的值进行循环比较，如满足条件，则将该行的下一行作为字典的Key，将B、C列用逗号串接后，作为字典的Item，
- 由于需要从大到小排列，故循环时，直接从大往小，使用Step -1的方式，避免后期再排序；
- 由于B、C列用逗号串接，使用d.Items返回后，需要再以逗号进行分列，使用的语句为：
- Columns("F:F").TextToColumns Comma:=True
- Columns("J:J").TextToColumns Comma:=True
详细代码如下：
- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
- If Target.Address = "$P$2" Then
-
- On Error Resume Next
- Application.ScreenUpdating = False
- Set d = CreateObject("scripting.dictionary")
- Set dd = CreateObject("scripting.dictionary")
- arr = Cells(1, 1).CurrentRegion.Value
- Ct = Cells(1, 4).Text
- CtD1 = Cells(1, "H").Text: CtD2 = Cells(2, "H").Text
- Union(Columns("E:G"), Columns("I:K")).ClearContents
- For i = UBound(arr, 1) To 3 Step -1
- If arr(i - 1, 2) = Ct Then d(arr(i, 1)) = arr(i, 2) & "," & arr(i, 3)
- If arr(i - 2, 2) = CtD1 And arr(i - 1, 2) = CtD2 Then dd(arr(i, 1)) = arr(i, 2) & "," & arr(i, 3)
- Next
- If arr(1, 2) = Ct Then d(arr(2, 1)) = arr(2, 2) & "," & arr(2, 3)
-
- Cells(1, "E").Resize(d.Count, 1) = Application.Transpose(d.keys)
- Cells(1, "F").Resize(d.Count, 1) = Application.Transpose(d.items)
- Cells(1, "I").Resize(dd.Count, 1) = Application.Transpose(dd.keys)
- Cells(1, "J").Resize(dd.Count, 1) = Application.Transpose(dd.items)
- Union(Range("E:E"), Range("I:I")).NumberFormatLocal = "0000"
-
- Application.DisplayAlerts = False
- Columns("F:F").TextToColumns Comma:=True
- Columns("J:J").TextToColumns Comma:=True
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- End If
- End Sub
 VBA条件筛选排序实例zz.rar
|