Как очистить клетки на основе пробела / критериев

Question

С моим текущим кодом я пытаюсь очистить соответствующие ячейки (столбцы K: N), когда столбец (C: J) пуст.Это ссылка Rng.Я думаю, что это оператор If Then, но не уверен, как его вписать в код ... Я понимаю, что это долго, но любая помощь будет фантастической!

Например, если C30: J30 пуст, он очищаетсяK30: N30.Это If Then оператор с ClearContents?Или, если C15: J15 пусто, тогда очистите K15: N15 и т. Д.

Я ищу помощь по очистке ячеек, которые находятся в той же строке, что и критерии «Активные».Но только после того, как он скопирован из «Future Project Hopper» в «CPD-Carryover, Complete & Active».Пытаясь убедиться, что это не сбивает с толку, когда я копирую / очищаю 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

Отредактированный новый ответ:

Я проверил ваш код, и, если я понимаю, ваша реальная цель - очистить отфильтрованные строки от 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 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

Попробуйте:

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