Как изменить этот код для поиска только видимых строк и столбцов - PullRequest
Новая
       27

Как изменить этот код для поиска только видимых строк и столбцов

3 голосов
/ 25 мая 2019

У меня есть пользовательская форма, которая позволяет пользователю выбирать, какие строки и столбцы релевантны для проверки пользователем. Я использую этот код, но он ищет все строки и все столбцы и, следовательно, не удаляет правильные строки. Может ли кто-нибудь предложить решение для исправления этого, который будет работать для строк и столбцов? Спасибо. 

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

Ответы [ 2 ]

1 голос
/ 25 мая 2019

Я собирался предложить то же самое, что и 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
1 голос
/ 25 мая 2019

Вы можете проверить, скрыта ли ячейка через их свойства .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
...