Как выполнить автофильтр, а затем копировать и вставлять только видимые ячейки

Я пытаюсь в основном заполнить любые пустые ячейки в столбце «AM» значениями из столбца «AN» на рабочем листе под названием «Оператор», назначив форму макросу с помощью следующего кода. Обратите внимание, что в ячейках An есть уравнение, поэтому я хочу скопировать только значения.

Sub PendingChanges()

Range("AM1:AM10").CurrentRegion.AutoFilter Field:=1, Criteria1:="="

        Worksheets("Operator").Range("AM1:AM10").SpecialCells(xlCellTypeVisible).Value = Worksheets("Operator").Range("AN1:AN10").Value

    Selection.AutoFilter Field:=1

End Sub

Я знаю, что есть метод «SpecialCells», который отображает только видимые ячейки (поэтому после автофильтрации он будет показывать пробелы для меня), но я не уверен, как включить его в мой код! Следующий снимок экрана показывает, как изначально будет выглядеть лист: (в этом примере значения ячеек AN3 и AN5 будут вставлены в AM3 и AM5 соответственно:

введите описание изображения здесь

Мой код автофильтрует столбец «AN» для любых пустых ячеек, затем пытается скопировать ячейки в AN и вставляет значения видимых ячеек в ячейки в AM . Результат должен быть следующим:

введите описание изображения здесь

Всего 2 ответа


Нет необходимости фильтровать здесь; Вы можете просто использовать SpecialCells(xlCellTypeBlanks) , а затем Offset по результату для ссылки на те же строки, но в столбце «AN».

Sub PendingChanges()

    On Error Resume Next
    Dim blankCells as Range
    Set blankCells = Worksheets("Operator").Range("AM1:AM10").SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0

    If Not blankCells Is Nothing Then
        Dim rng as Range
        For Each rng in blankCells.Areas
            rng.Value = rng.Offset(,1).Value
        Next
    End If

End Sub

Некоторые заметки:

  • Необходимы On Error Resume Next и On Error GoTo 0 , так как вызов SpecialCells(xlCellTypeBlanks) не будет выполнен, если нет пробелов. Они временно отключают, а затем снова включают обработку ошибок.
  • Areas - это каждая отдельная область несмежного диапазона. Например, если blankCells относится к AM2 и AM4:AM5 , то AM2 является первой областью, а AM4:AM5 - второй.
  • Вам необходимо циклически проходить по областям, потому что попытка передачи значения .Value = .Value не работает правильно, если имеется более одной области.

Вам не нужно создавать фильтры, а затем заполнять пробелы в следующем столбце. Вы можете попробовать приведенный ниже код, это может напрямую решить вашу проблему.

[VBA]
Sub test()
Dim rBlanks As Range

Set rBlanks = Nothing
With ThisWorkbook.Sheets("Operator")
On Error Resume Next
Set rBlanks = Intersect(.Range("AM:AM"), .UsedRange).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If Not rBlanks Is Nothing Then
rBlanks.FormulaR1C1 = "=RC[1]"
Intersect(.Range("AM:AM"), .UsedRange).Copy
.Range("AM1").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
End If
End With

End Sub
[/VBA]

Есть идеи?

10000