如何修改此代码以仅搜索可见的行和列

How to modify this code to only search visible rows and columns

我有一个用户表单,允许用户 select 哪些行和列与用户相关以进行检查。我正在使用这段代码,但它会搜索所有行和所有列,因此不会删除正确的行。谁能建议解决此问题的解决方案,该解决方案适用于行和列?谢谢

Dim RowToTest As Long
Dim MySheet As Worksheet
Dim ProjectedDate As Date
Dim ColToTest As Long
Dim TempKeep As Integer
TempKeep = 0

ProjectedDate = Date + 60

For Each MySheet In ThisWorkbook.Sheets
    For RowToTest = MySheet.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        For ColToTest = MySheet.Cells(2, Columns.Count).End(xlToLeft).Column To 15 Step -1
            With MySheet.Cells(RowToTest, ColToTest)
                If IsDate(MySheet.Cells(RowToTest, ColToTest).Value) Then
                    If .Value < ProjectedDate Then
                        TempKeep = 1
                    End If
                End If
            End With
        Next ColToTest
        If TempKeep = 0 Then
            MySheet.Rows(RowToTest).EntireRow.Delete
        End If
        TempKeep = 0
    Next RowToTest
Next

您可以通过 .Rows.Columns 属性 检查单元格是否隐藏,如下所示:

If CelToCheck.Rows.Hidden or CelToCheck.Columns.Hidden Then
    'Your code if hidden
Else
    'Code if not hidden
End if

在你的情况下,CelToCheck 将是

MySheet.Cells(RowToTest, ColToTest)

或者,您可以设置一个范围变量并仅使用

循环访问可见单元格
For each CL in RangeVariable.SpecialCells(xlCellTypeVisible)
    'Your code
Next CL

我正要建议与 JvdV 相同,使用 .Hidden 属性。可以像这样在您的代码中使用它:

Dim RowToTest As Long
Dim MySheet As Worksheet
Dim ProjectedDate As Date
Dim ColToTest As Long
Dim TempKeep As Integer
TempKeep = 0

ProjectedDate = Date + 60

For Each MySheet In ThisWorkbook.Sheets
    For RowToTest = MySheet.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        For ColToTest = MySheet.Cells(2, Columns.Count).End(xlToLeft).Column To 15 Step -1
            With MySheet.Cells(RowToTest, ColToTest)
                If IsDate(MySheet.Cells(RowToTest, ColToTest).Value) Then
                    If .Value < ProjectedDate Then
                        TempKeep = 1
                    End If
                End If
            End With
        Next ColToTest
        If TempKeep = 0 and Not isHiddenRow(MySheet, RowToTest) Then
            MySheet.Rows(RowToTest).EntireRow.Delete
        End If
        TempKeep = 0
    Next RowToTest
Next

不一定需要有一个函数来这样做,但可以更容易地重用代码。

Function isHiddenRow(sht As Worksheet, rowNr As Long) As Boolean
    On Error Resume Next
    isHiddenRow = sht.Rows(rowNr).Hidden
End Function

Function isHiddenCol(sht As Worksheet, colNr As Long) As Boolean
    On Error Resume Next
    isHiddenCol = sht.Columns(colNr).Hidden
End Function

PS:根据 sheet 中的数据量,直接在 sheet 上循环通常不是一个好主意。如果您有数千行,请考虑使用 arrays

编辑: 添加了一个使用数组来做同样事情的替代方法。

Option Explicit

Sub delVisibleRows()
Dim MySheet As Worksheet
Dim ProjectedDate As Date: ProjectedDate = Date + 60

Dim R As Long, C As Long, lRow As Long, lCol As Long
Dim arrData As Variant
Dim strRange As String

    For Each MySheet In ThisWorkbook.Sheets 'for each sheet
        With MySheet
            lRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'get last row
            lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column 'get last column
            arrData = .Range(.Cells(1, 1), .Cells(lRow, lCol)) 'allocate the data to an array

            For R = 2 To lRow 'iterate through all rows starting at 2
                For C = 15 To lCol 'iterate through all columns, starting at 15 - this could cause a problem if there are less than 15 columns
                    If IsDate(arrData(R, C)) And arrData(R, C) < ProjectedDate Then 'check if is date, and if is less than projected date
                        Exit For 'if it is, skip to next row
                    End If

                    If C = lCol Then  'If we got to last col without meeting the skip condition
                        strRange = strRange & R & ":" & R & "," 'build the string for the range to delete
                    End If
                Next C
            Next R

            strRange = Left(strRange, Len(strRange) - 1) 'get rid of the last comma
            .Range(strRange).SpecialCells(xlCellTypeVisible).EntireRow.Delete 'delete only the visible rows
        End With
    Next MySheet
End Sub