Для каждой пустой ячейки в столбце запустите макрос автозаполнения - PullRequest
1 голос
/ 25 апреля 2020

enter image description here

К этому:

enter image description here

Я бы например, набор кода, чтобы можно было поднять каждый пробел в столбце C и выполнить в нем макрос. Было бы легко, если бы мой лист имел фиксированный диапазон, однако мой список постоянно увеличивается в строках ... Следовательно, мне нужно, чтобы макрос мог запускать макрос на пустых ячейках и пропускать эти заполненные ячейки. Макрос также должен заканчиваться последней заполненной ячейкой в ​​столбце .

 Sub Testing()

Dim Rl As Long                      ' last row
Dim Tmp As Variant
Dim R As Long                       ' row counter

With ThisWorkbook.ActiveSheet       ' modify to suit
    Rl = .Cells(.Rows.Count, "C").End(xlUp).Row
    ' work on column C
    For R = 1 To Rl                 ' start the loop in row 1
        Tmp = .Cells(R, "C").Value
        If Len(Tmp) Then
            Cells(R, "C").Select
            Call AutoFill
        End If
    Next R
End With


Sub AutoFill()
Application.EnableEvents = False
    Dim rng As Range
    Set rng = Range(Selection, Selection.End(xlDown))
    Set rng = rng.Resize(rng.Rows.Count - 1, rng.Columns.Count)
    rng.FillDown

End Sub

1 Ответ

3 голосов
/ 25 апреля 2020

Ваша проблема здесь: If Len(Tmp) Then, и это просто проверка, имеет ли Tmp какую-либо длину. Так что это фактически игнорирует ваши пустые клетки, пропуская их. Вместо этого вы выбираете ячейки со значениями в них.

Не делайте l oop всех ячеек в диапазоне. Вместо этого просто посмотрите на эти пустые клетки, представляющие интерес. Например:

Sub Testing()

Dim LR As Long, LC as Long
Dim rng As Range
Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
    LR = .Cells(.Rows.Count, "A").End(xlUp).Row
    LC = .Cells(LR, .Columns.Count).End(xlToLeft).Column
    Set rng = .Range(.Cells(1, 1), .Cells(LR, LC))
    If WorksheetFunction.CountBlank(rng) > 0 Then
        For Each area In rng.SpecialCells(xlCellTypeBlanks).Areas
            area.Offset(-1).Resize(area.Rows.Count + 1).FillDown
        Next
    End If
End With

End Sub

Как видите, я пропустил .Select и ActiveSheet, так как это плохое кодирование и обычно вообще не нужно.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...