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

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

1 голос
/ 16 января 2020

Я пытаюсь в основном заполнить все пустые ячейки в столбце "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 соответственно:

enter image description here

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

enter image description here

Ответы [ 2 ]

2 голосов
/ 16 января 2020

Нет необходимости фильтровать здесь; Вы можете просто использовать 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 - вторая.
  • Вам необходимо l oop через эти области, потому что попытка передачи значения .Value = .Value не работает правильно, если имеется более одной области.
0 голосов
/ 16 января 2020

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

[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]
...