[已解决]资料筛选与筛选复制问题

lkk0063

按下"AutoFilter"按钮,会自动跳出输入月份视窗,输入后会自动筛选 C 整个栏位与 BF 无空白栏位
1.想新增可输入一个筛选 D 整个栏位(输入16 旧筛选有 16 的资料)
2.将所有资料筛选后将复制到Output(如Output sheet)

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-7-31 14:40

1. Private Sub CommandButton1_Click()
   
2. Dim n, n1
   
3. n = InputBox("Pls  Input  Month")
   
4. If n = "" Then Exit Sub
   
5. If VBA.IsNumeric(n) <> True Then
   
6.   MsgBox "Pls  Input  Value!!"
   
7. Exit Sub
   
8. End If
   
9. If CInt(n) > 12 Or (n) < 1 Then
   
10.   MsgBox "Pls  Check  Month!!"
    
11. Exit Sub
    
12. End If
    
13. n1 = InputBox("Pls  Input  Day")
    
14. With Sheets("Input")
    
15. .Range("a2:bl" & [a65536].End(3).Row).AutoFilter Field:=3, Criteria1:=">=" & DateSerial(Year(Now), n, 1), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now), n + 1, 0)
    
16. .Range("d2").AutoFilter Field:=4, Criteria1:=n1
    
17. .Range("BH2").AutoFilter Field:=60, Criteria1:="<>"
    
18. End With
    
19. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Private Sub CommandButton1_Click()
   
2. Dim n, n1
   
3. n = InputBox("Pls  Input  Month")
   
4. If n = "" Then Exit Sub
   
5. If VBA.IsNumeric(n) <> True Then
   
6.   MsgBox "Pls  Input  Value!!"
   
7. Exit Sub
   
8. End If
   
9. If CInt(n) > 12 Or (n) < 1 Then
   
10.   MsgBox "Pls  Check  Month!!"
    
11. Exit Sub
    
12. End If
    
13. n1 = InputBox("Pls  Input  Day")
    
14. With Sheets("Input")
    
15. .Range("a2:bl" & [a65536].End(3).Row).AutoFilter Field:=3, Criteria1:=">=" & DateSerial(Year(Now), n, 1), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now), n + 1, 0)
    
16. .Range("d2").AutoFilter Field:=4, Criteria1:=n1
    
17. .Range("BH2").AutoFilter Field:=60, Criteria1:="<>"
    
18. End With
    
19. End Sub

复制代码

lkk0063

大灰狼1976 发表于 2017-7-31 14:40

1. Private Sub CommandButton1_Click()
   
2. Dim n, n1
   
3. n = InputBox("Pls  Input  Month")
   
4. If n = "" Then Exit Sub
   
5. If VBA.IsNumeric(n) <> True Then
   
6.   MsgBox "Pls  Input  Value!!"
   
7. Exit Sub
   
8. End If
   
9. If CInt(n) > 12 Or (n) < 1 Then
   
10.   MsgBox "Pls  Check  Month!!"
    
11. Exit Sub
    
12. End If
    
13. n1 = InputBox("Pls  Input  Day")
    
14. With Sheets("Input")
    
15. .Range("a2:bl" & [a65536].End(3).Row).AutoFilter Field:=3, Criteria1:=">=" & DateSerial(Year(Now), n, 1), Operator:=xlAnd, Criteria2:="<=" & DateSerial(Year(Now), n + 1, 0)
    
16. .Range("d2").AutoFilter Field:=4, Criteria1:=n1
    
17. .Range("BH2").AutoFilter Field:=60, Criteria1:="<>"
    
18. 
    
19. Sheets(2).UsedRange.Clear
    
20.     Sheets(1).UsedRange.SpecialCells(xlCellTypeVisible).Copy _
    
21.         Destination:=Sheets(2).Range("A1")
    
22. 
    

复制代码

你好,
若想将资料sheet(1)复制sheet(2) A:D 栏位与 XX:YY栏位 红字部分如何修改?

Sheets(2).UsedRange.Clear
    Sheets(1).UsedRange.SpecialCells(xlCellTypeVisible).Copy _
        Destination:=Sheets(2).Range("A1")