如何修改此代码以仅搜索可见的行和列
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
我有一个用户表单,允许用户 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