Question

使用当前代码，当列（C：J）为空白时，我试图清除相应的单元格（列K：N）。是Rng的参考。我认为这是一个If Then语句，但是不确定如何将其放入代码中...我知道这很长，但是任何帮助都太棒了！

例如，如果C30：J30为空，则清除K30：N30。它是带有If Then的{{1}}语句吗？或者，如果C15：J15为空白，则清除K15：N15，等等。

我正在寻找有关清除与“有效”条件同一行的单元格的帮助。但是，只有在将其从“ Future Project Hopper”复制到“ CPD-Carryover，Complete＆Active”之后。尝试确保当我将C复制/清除到J并在K到N列中留有一些数据时，不会造成混乱。我正在这样做，供其他个人轻松地将Active项目从一张纸移到另一张纸。

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

编辑新答案：

我测试了您的代码，据我了解，您的真正目的是清除已过滤行（列C中单元格所在的行，N至D的列"Active"说，您已经设法将C列清除到J，因此是问题。

我建议的解决方案一次性清除C至N行中的所有内容，而无需任何中介步骤。因为已经确定了感兴趣的行，所以不需要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）。

根据我对代码的了解，它在工作表（“ Future Project Hopper”）中获取一系列数据，将其过滤并复制到工作表“ CPD-Carryover，Complete＆Active”中。如果要清除后者，则必须将附加代码放在rng.Rows.ClearContents之前或之后的末尾。

Answer 3

通过尝试过滤空白并清除内容（尝试为空白行创建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

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

3 个答案: