如何根据空白/条件清除单元格

Question

使用我当前的代码，当列(C：J)为空时，我正在尝试清除相应的单元格(K：N列)。这是Rng的参考。我认为这是一个If Then语句，但不确定如何在代码中适应它...... 我知道这很长，但任何帮助都会很棒！

例如，如果 C30：J30 为空，则清除 K30：N30。 是ClearContents的If Then声明吗？或者，如果 C15：J15 为空白，则清除 K15：N15 等。

我正在寻找有关清除与"活动"条件位于同一行的单元格的帮助。但是，只有在它从"未来项目漏斗"复制到"CPD-结转，完成和活动"之后。试图确保当我将 C 复制/清除到 J 并在 K 到 N 列中留下一些数据时不会混淆。我正在为其他人制作这个，以便轻松地将活动项目从一个工作表移动到另一个工作表。

Const cCrit As Variant = "D"      ' Criteria Column Letter/Number
Const cCols As String = "C:J"     ' Source/Target Data Columns
Const cFRsrc As Long = 15         ' Source First Row
Dim ws1 As Worksheet              ' Source Workbook
Dim ws2 As Worksheet              ' Target Workbook
Dim rng As Range                  ' Filter Range, Copy Range
Dim lRow As Long                  ' Last Row Number
Dim FRtgt As Long                 ' Target First Row
Dim Answer As VbMsgBoxResult      ' Message Box
Dim Error1 As VbMsgBoxResult      ' Message Box for Errors
' Create references to worksheets.
With ThisWorkbook
Set ws1 = .Worksheets("Future Project Hopper")
Set ws2 = .Worksheets("CPD-Carryover,Complete&Active")
End With
Answer = MsgBox("Do you want to run the Macro?", vbYesNo, "Run Macro")
If Answer <> vbYes Then Exit Sub
' In Source Worksheet
With ws1
' Clear any filters.
.AutoFilterMode = False
' Calculate Last Row.
lRow = .Cells(.Rows.Count, cCrit).End(xlUp).row
' Calculate Filter Column Range.
Set rng = .Cells(cFRsrc, cCrit).Resize(lRow - cFRsrc + 1)
' Make an offset for the filter to start a row before (above) and
' end a row after (below).
With rng.Offset(-1).Resize(lRow - cFRsrc + 3)
' Filter data in Criteria Column.
.AutoFilter Field:=1, Criteria1:="Active"
End With
' Create a reference to the Copy Range.
Set rng = .Columns(cCols).Resize(rng.Rows.Count).Offset(cFRsrc - 1) _
.SpecialCells(xlCellTypeVisible)
' Clear remaining filters.
.AutoFilterMode = False
End With
' Calculate Target First Row.
FRtgt = ws2.Cells(ws2.Rows.Count, cCrit).End(xlUp).row + 1
' Copy Range and paste to Target Worksheet and clear contents of future project hopper
rng.Copy
ws2.Columns(cCols).Resize(1).Offset(FRtgt - 1).PasteSpecial xlPasteValues
rng.Rows.ClearContents

Answer 1

尝试：

Option Explicit
Sub test()
Dim Counts As Long
With ThisWorkbook.Worksheets("Sheet1")
Counts = Application.WorksheetFunction.CountA(.Range("C30:J30"))
If Counts = 0 Then
.Range("K30:N30").ClearContents
End If
End With
End Sub

Answer 2

通过过滤空白并清除内容诗句来解决此问题，试图为空白行创建If Then。

Range("D14").Select
'Re-add filter
Selection.AutoFilter
'Fitler for blanks
ActiveSheet.Range("$A$14:$N$34").AutoFilter Field:=4, Criteria1:="="
ActiveWindow.SmallScroll Down:=-6
'Select Area to be cleared - work around by not clearing based on blank criteria but on filter
Range("K18:N208").Select
'Clear potential savings for moved active projects
Selection.ClearContents
Range("M39").Select
'Unfilter for blanks
ActiveSheet.Range("$A$14:$N$34").AutoFilter Field:=4
ActiveWorkbook.Worksheets("Future Project Hopper").AutoFilter.Sort.SortFields. _
Clear
'Filter A-Z
ActiveWorkbook.Worksheets("Future Project Hopper").AutoFilter.Sort.SortFields. _
Add Key:=Range("D14:D34"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Future Project Hopper").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Answer 3

编辑新答案：

我测试了您的代码，如果我理解，您的真正目的是清除过滤行(第D列中的单元格表示"Active"的行)上C要N的列。您已经设法清除了C到J的列，因此提出了问题。

我提出的解决方案是一次性清除行CN上的所有内容，无需中间步骤。由于已标识感兴趣的行，因此不需要If... Then条件。

单元格清除确实在复制操作后发生。

因为我对Resize, Offset和Cells不太满意，所以提出的解决方案使用不同的功能，但应该工作相同。

在这里：

Const cCrit As Variant = "D"      ' Criteria Column Letter/Number
Const cCols As String = "C:J"     ' Source/Target Data Columns
Const cFRsrc As Long = 15         ' Source First Row
Sub test()
Dim ws1 As Worksheet              ' Source Workbook
Dim ws2 As Worksheet              ' Target Workbook
Dim rng As Range                  ' Filter Range, Copy Range
Dim rngClear As Range             ' Range to be cleared after copy
Dim lRow As Long                  ' Last Row Number
Dim FRtgt As Long                 ' Target First Row
Dim Answer As VbMsgBoxResult      ' Message Box
Dim Error1 As VbMsgBoxResult      ' Message Box for Errors
' Create references to worksheets.
With ThisWorkbook
Set ws1 = .Worksheets("Feuil1")
Set ws2 = .Worksheets("Feuil2")
End With
Answer = MsgBox("Do you want to run the Macro?", vbYesNo, "Run Macro")
If Answer <> vbYes Then Exit Sub
' In Source Worksheet
With ws1
' Clear any filters.
.AutoFilterMode = False
' Calculate Last Row.
lRow = .Cells(.Rows.Count, cCrit).End(xlUp).Row
' Calculate Filter Column Range.
Set rng = .Cells(cFRsrc, cCrit).Resize(lRow - cFRsrc + 1)
' Make an offset for the filter to start a row before (above) and
' end a row after (below).
With rng.Offset(-1).Resize(lRow - cFRsrc + 3)
' Filter data in Criteria Column.
.AutoFilter Field:=1, Criteria1:="Active"
End With
' Create a reference to the Copy Range.
Set rng = .Columns(cCols).Resize(rng.Rows.Count).Offset(cFRsrc - 1) _
.SpecialCells(xlCellTypeVisible)
'Set here the range to be cleared after the copy. Same rows as rng, but with extended columns (C to N)
Set rngClear = .Range("C" & cFRsrc & ":" & "N" & lRow).SpecialCells(xlCellTypeVisible)
' Clear remaining filters.
.AutoFilterMode = False
End With
' Calculate Target First Row.
FRtgt = ws2.Cells(ws2.Rows.Count, cCrit).End(xlUp).Row + 1
' Copy Range and paste to Target Worksheet and clear contents of future project hopper
rng.Copy
ws2.Columns(cCols).Resize(1).Offset(FRtgt - 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Clears columns C to N in ws1 for copied rows
rngClear.ClearContents
End Sub

您可以通过对"C","N"使用变量来进一步改进此代码。

旧答案：

一些代码可能会有所帮助：

If IsEmpty(Range("C30:D30")) Then
Range("K30:N30").ClearContents
Endif

从那里，您必须在给定的范围内循环(您可能可以为此重用lrow或rng.Rows.Count)。

根据我从代码中了解到的情况，它在工作表("未来项目漏斗")中获取一系列数据，对其进行过滤并将其复制到工作表"CPD-结转，完成和活动"中。 如果要清除后者，则必须将附加代码放在末尾，rng.Rows.ClearContents之前或之后。