Получить номер строки первой пустой ячейки в столбце и сохранить это значение в другой ячейке

Question

Я хочу найти номер строки первой пустой ячейки в столбце и сохранить этот номер строки в ячейке Z1.

Я пробовал использовать следующий код макроса, но он всегда входит в l oop. Как только он пытается установить значение в ячейке Z1, он снова переходит в событие worksheet_change, а затем снова в течение l oop.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
    Set ws = ActiveSheet
    For Each cell In ws.Columns(3).Cells
        If IsEmpty(cell) = True Then Range("$Z$1").Value = cell.Row: Exit For
      Next cell
End Sub

Пожалуйста, помогите решить эту проблему.

Спасибо

Answer 1

Может быть, этот код вам поможет

    Option Explicit

    Function firstEmptyCell(col As Long, Optional ws As Worksheet) As Range

    If ws Is Nothing Then
        Set ws = ActiveSheet
    End If

    Dim rg As Range
    Set rg = ws.Cells(1, col)

    If Len(rg.Value) = 0 Then
        Set rg = rg.Offset
    Else
        If Len(rg.Offset(1).Value) = 0 Then
            Set rg = rg.Offset(1)
        Else
            Set rg = rg.End(xlDown)
            Set rg = rg.Offset(1)
        End If
    End If
    Set firstEmptyCell = rg

End Function

И код события

    Private Sub Worksheet_Change(ByVal Target As Range)

        On Error GoTo EH

        If Target.Column <> 12 Then
            Exit Sub
        End If

        Application.EnableEvents = False
        Range("Z1").Value = firstEmptyCell(12).Row

    EH:
        Application.EnableEvents = True
    End Sub

Обновление : основано на комментариях относительно ловушек изменить событие можно немного изменить firstEmptyCell и использовать только UDF

Function firstEmptyCellA(col As Long, Optional ws As Worksheet) As Long

    On Error GoTo EH
    If ws Is Nothing Then
        Set ws = ActiveSheet
    End If

    Application.Volatile

    Dim rg As Range
    Set rg = ws.Cells(1, col)

    If Len(rg.Value) = 0 Then
        Set rg = rg.Offset
    Else
        If Len(rg.Offset(1).Value) = 0 Then
            Set rg = rg.Offset(1)
        Else
            Set rg = rg.End(xlDown)
            Set rg = rg.Offset(1)
        End If
    End If
    firstEmptyCellA = rg.Row
    Exit Function
EH:
    firstEmptyCellA = 0

End Function

Answer 2

События Tricky Enable

Это срабатывает только при изменении ячейки в 12-м столбце (L), в противном случае в этом нет необходимости. Если у вас есть формулы, это не будет работать, и вам придется использовать событие Worksheet_Calculate.

Ряд первой пустой ячейки в столбце

Option Explicit

' Row of First Empty Cell in Column
Private Sub Worksheet_Change(ByVal Target As Range)

    Const TargetCell As String = "Z1"
    Const TargetColumn As Variant = 12   ' (or "L")
    Dim rng As Range

    If Intersect(Columns(TargetColumn), Target) Is Nothing Then Exit Sub

    Application.EnableEvents = False
        Set rng = Columns(TargetColumn).Find(What:="", _
          After:=Cells(Rows.Count, TargetColumn), LookIn:=xlValues)
        If rng Is Nothing Then
            Range(TargetCell).Value = 0  ' Full column. No empty cells.
        Else
            Range(TargetCell).Value = rng.Row
        End If
    Application.EnableEvents = True

End Sub

строка первой пустой ячейки после последней непустой ячейки в столбце

Option Explicit

' Row of First Empty Cell After Last Non-Empty Cell in Column
Private Sub Worksheet_Change(ByVal Target As Range)

    Const TargetCell As String = "Z1"
    Const TargetColumn As Variant = 12   ' (or "L")
    Dim rng As Range

    If Intersect(Columns(TargetColumn), Target) Is Nothing Then Exit Sub

    Application.EnableEvents = False
        Set rng = Columns(TargetColumn).Find(What:="*", LookIn:=xlFormulas, _
          SearchDirection:=xlPrevious)
        If rng Is Nothing Then           ' Empty column. No non-empty cells.
            Range(TargetCell).Value = 1
        Else
            If rng.Row = Rows.Count Then ' Last (bottom-most) cell is not empty.
                Range(TargetCell).Value = 0
            Else
                Range(TargetCell) = rng.Offset(1).Row
            End If
        End If
    Application.EnableEvents = True

End Sub

Answer 3

Не нужно все oop. Вставьте это в модуль, а не в событие рабочего листа, если только вы не хотите, чтобы это происходило при каждом изменении рабочего листа.

Sub Macro1()
    ActiveSheet.Range("Z1") = ActiveSheet.Columns(3).SpecialCells(xlCellTypeBlanks)(1).Row
End Sub

, если вы хотите его после каждого изменения, поместите его в рабочий лист как. Этот код не будет работать каждый раз. Он проверит, является ли Z1 пустым, затем введите значение. Затем, если Z1 не пуст, он проверит, находится ли целевая ячейка в столбце C

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Set Rng = ActiveSheet.Columns(3)

If IsEmpty(Range("Z1")) Then
    Range("Z1") = Rng.SpecialCells(xlCellTypeBlanks)(1).Row
Else
If Not Intersect(Range("C1:C" & Range("Z1").Value), Target) Is Nothing Then
    Range("Z1") = Rng.SpecialCells(xlCellTypeBlanks)(1).Row
End If
End If
End Sub