仅对循环使用过滤的行

基本上我有一些下面的代码工作正常，只是我希望它只处理过滤的数据，就像它从“Allsites”又名主表中运行，同时过滤它仍然使用所有的数据。 我只是想知道是否有任何运行的代码只在过滤的数据？

Dim lngLastRow As Long Dim fpath As String Dim owb As Workbook Dim Master As Worksheet 'declare both Dim Slave As Worksheet Worksheets("SHLAA").Activate Worksheets("SHLAA").Select Set Master = ThisWorkbook.Worksheets("Allsites") 'sheet from workbook im in Set Slave = ThisWorkbook.Worksheets("SHLAA") 'sheet in workbook im copying too lngLastRow = Slave.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1 For j = 1 To 1000 '(the master sheet) For i = 1 To 1000 '(the slave sheet) 'for first 1000 cells If Trim(Master.Cells(j, 8).Value2) = vbNullString Then Exit For 'if ID cell is blank jump to last line If Master.Cells(j, 3).Value = Slave.Cells(i, 8).Value Then Slave.Cells(i, 4).Value = "31/03/2015" Slave.Cells(i, 5).Value = Master.Cells(j, 8).Value Slave.Cells(i, 7).Value = "Planning Permission" Slave.Cells(i, 8).Value = Master.Cells(j, 3).Value Slave.Cells(i, 17).Value = Master.Cells(j, 9).Value Slave.Cells(i, 24).Value = "1" Slave.Cells(i, 27).Value = Master.Cells(j, 15).Value Slave.Cells(i, 30).Value = Master.Cells(j, 16).Value Slave.Cells(i, 31).Value = Master.Cells(j, 17).Value Slave.Cells(i, 48).Value = "Housing only" Slave.Cells(i, 52).Value = "MBC" Slave.Cells(i, 61).Value = "Manual" Slave.Cells(i, 62).Value = Master.Cells(j, 29).Value Slave.Cells(i, 63).Value = "0" Slave.Cells(i, 64).Value = "Y" Slave.Cells(i, 65).Value = "Yes" End If Next Next MsgBox ("Data Transfer Successful") 

Answer 1

replace这个：

 For j = 1 To 1000 '(the master sheet) 

有了这个：

 For each cell in master.range("h2:h1000").specialcells(xlcelltypevisible) j = cell.row 

并添加

 Dim cell as Range 

到代码的顶部。

Answer 2

您可以通过检查RowHeight属性（0或不）来排除已过滤的行：

 If Master.Cells(j, 3).RowHeight = 0 Then 

---

 Option Explicit Public Sub noName() Dim lngLastRow As Long Dim fpath As String Dim owb As Workbook Dim Master As Worksheet 'declare both Dim Slave As Worksheet Dim i As Long, j As Long Worksheets("SHLAA").Activate Worksheets("SHLAA").Select Set Master = ThisWorkbook.Worksheets("Allsites") 'sheet from workbook im in Set Slave = ThisWorkbook.Worksheets("SHLAA") 'sheet in workbook im copying too lngLastRow = Slave.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1 For j = 1 To 1000 '(the master sheet) For i = 1 To 1000 '(the slave sheet) 'for first 1000 cells If Trim(Master.Cells(j, 8).Value2) = vbNullString Then Exit For With Slave If Master.Cells(j, 3).RowHeight = 0 Then If Master.Cells(j, 3).Value = .Cells(i, 8).Value Then .Cells(i, 4).Value = "31/03/2015" .Cells(i, 5).Value = Master.Cells(j, 8).Value .Cells(i, 7).Value = "Planning Permission" .Cells(i, 8).Value = Master.Cells(j, 3).Value .Cells(i, 17).Value = Master.Cells(j, 9).Value .Cells(i, 24).Value = "1" .Cells(i, 27).Value = Master.Cells(j, 15).Value .Cells(i, 30).Value = Master.Cells(j, 16).Value .Cells(i, 31).Value = Master.Cells(j, 17).Value .Cells(i, 48).Value = "Housing only" .Cells(i, 52).Value = "MBC" .Cells(i, 61).Value = "Manual" .Cells(i, 62).Value = Master.Cells(j, 29).Value .Cells(i, 63).Value = "0" .Cells(i, 64).Value = "Y" .Cells(i, 65).Value = "Yes" End If End If End With Next Next MsgBox ("Data Transfer Successful") End Sub