Question

基本上我已经获得了一些工作正常的代码，只是我希望它只能处理过滤后的数据 - 就像它从＆＃34; Allsites＆＃34;也就是主题表，虽然过滤它仍然使用所有数据。我只是想知道是否还有仅在过滤数据上运行代码？

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

替换它：

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或不是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

仅将过滤行用于循环

2 个答案: