用AutoFilter筛选后选取区域

simic1989

请问用AutoFilter筛选后，如何只选取筛选出来的区域，然后获取筛选出来区域共多少行。
知道有多少行后，在表2中插入相应的行数，并把筛选出来的内容复制过去。

Chip_Kenny

1. Sub tex()
   
2. irow = Sheet1.Range("a65536").End(xlUp).Row
   
3. Sheet1.Range("a1:f" & irow).AutoFilter Field:=4, Criteria1:="一车间"
   
4. r = [a1].End(4).Row
   
5. For i = 1 To r
   
6.     If Rows(i).Height Then j = j + 1
   
7. Next
   
8. MsgBox "Range(" & Range("a1:f" & r).Address(0, 0) & ")" & Chr(10) & "Rows(" & j & ")"
   
9. End Sub

复制代码

simic1989

Chip_Kenny 发表于 2018-9-12 12:45

请问这个好像可以统计筛选出来的行数，但是还是无法仅复制筛选出来的区域。我附件又更新了一下，麻烦指点一下

zy19880405

你这个是王佩丰的教学案例，直接看视频学不就完了？？

simic1989

zy19880405 发表于 2018-9-12 14:09
你这个是王佩丰的教学案例，直接看视频学不就完了？？

他那个不一样，他是把整个表1直接复制过来的，跟我的要求不太一样

Chip_Kenny

是否要這樣?

Chip_Kenny

是否要這樣?

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim rng As Range, i&
   
3. Set ic = Application.Intersect(Target, [a2:e2])
   
4. If ic Is Nothing Then End
   
5. Application.ScreenUpdating = 0
   
6. Application.EnableEvents = 0
   
7. i = [a1048576].End(3).Row
   
8. If i > 2 Then Rows("3:" & i).Delete
   
9. [a2:b2].NumberFormat = "@"
   
10. With Sheets(1)
    
11.         .[a1].CurrentRegion.AutoFilter Field:=ic.Column, Criteria1:=ic.Value
    
12.         .[a1].CurrentRegion.Copy
    
13.         [a1].Activate
    
14.         ActiveSheet.Paste
    
15.         .AutoFilterMode = 0
    
16. End With
    
17. Sheets(3).[a1:f1].Copy [a1048576].End(3)(2)
    
18. Application.EnableEvents = 1
    
19. Application.ScreenUpdating = 1
    
20. End Sub

复制代码

1. Sub zz()
   
2. Dim d As Object, i&
   
3. Application.EnableEvents = 0
   
4. Set d = CreateObject("scripting.dictionary")
   
5. i = [a1048576].End(3).Row
   
6. If i > 2 Then Rows("3:" & i).Delete
   
7. [a2:f2] = ""
   
8. With Sheets(1)
   
9.     ar = .[a1].CurrentRegion.Value
   
10.     For j = 1 To UBound(ar, 2) - 1
    
11.         For i = 2 To UBound(ar)
    
12.             d(ar(i, j)) = ""
    
13.         Next
    
14.         Cells(2, j).Validation.Delete
    
15.         Cells(2, j).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    
16.         xlBetween, Formula1:=Join(d.keys, ",")
    
17.         d.RemoveAll
    
18.     Next
    
19. End With
    
20. Set d = Nothing
    
21. MsgBox "Validation updated, please choice from [a2:e2]"
    
22. Application.EnableEvents = 1
    
23. End Sub

复制代码