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

Question

我有一个用户表单，允许用户选择哪些行和列与用户检查相关。我正在使用此代码，但它会搜索所有行和所有列，因此不会删除正确的行。任何人都可以提出解决此问题的解决方案，该解决方案适用于行和列吗？谢谢。

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

Answer 1

您可以通过.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

Answer 2

我正要建议与 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：取决于您的工作表中有多少数据，通常直接在工作表上循环并不是一个好主意。如果您有数千行，请考虑使用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