VBA 根據溢出范圍插入或刪除命名范圍中的行

Question

交叉發布於： https://www.mrexcel.com/board/threads/vba-to-insert-or-delete-rows-in-named-range-based-on-spill-range.1214814/#post-5937281

我有一個命名范圍“nameList”(B3:E20)，由單元格 B3 中動態數組公式的溢出范圍填充，並且在單元格 B24 下方有一個表格。 如果溢出范圍行數少於或多於 nameList 的行數，那么我希望刪除未使用的單元格，或者如果不夠，則插入新行，基本上我希望根據溢出范圍動態調整 nameList 的大小。

溢出范圍數據有時只有 2 行（未使用的行太多）或最多 50 行（由於下表導致溢出錯誤），這就是我希望調整 nameList 大小的原因

我一直在尋找類似的話題好幾個小時，但仍然沒有運氣。

這是到目前為止我從下面的答案中制作的代碼。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lsRow As Long
Dim lsEndRow As Long

lsRow = Range("B3").End(xlUp).Row
lsEndRow = lsRow

    Do While lsEndRow = Range("B" & Rows.Count).End(xlUp).Row
        If lsEndRow + 1 > "" Then
        Range(lsEndRow).EntireRow.Insert
        lsEndRow = Range("B" & Rows.Count).End(xlUp).Row
        End If
    Loop
    
Application.CutCopyMode = False
Application.EnableEvents = True
ActiveSheet.Range("B3").Select
End Sub

Answer 1

這應該是一個好的開始。

Sub Copy_Anniversary_Down()

Dim lsRow As Long
Dim lsEndRow As Long

lsRow = Range("B3").End(xlUp).Row
lsEndRow = lsRow
Do While lsEndRow <= Range("B" & Rows.Count).End(xlUp).Row
    If Range("B" & lsEndRow + 1) <> "" Then
    Range("B" & lsEndRow + 1, "D" & lsEndRow + 1).Copy
    Range("B" & lsEndRow + 1, "D" & lsEndRow + 1).PasteSpecial _
    Transpose:=True
    lsEndRow = vba.Application.ActiveSheet.Range("Z" &     vba.Application.Rows.Count).End(xlUp).Row
    End If
Loop
Application.CutCopyMode = False
Application.EnableEvents = True
ActiveSheet.Range("B3").Select

End Sub

Answer 2

已解決，但方法不同。

我的解決方法是插入大量行並觸發動態數組公式。

Range("B3").Rows.End(xlDown).Offset(1).Select
Selection.EntireRow.Resize(50).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

然后刪除 nameList 中的空行。

Range("nameList").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Resize(Selection.Rows.Count - 1).Select
Selection.EntireRow.Delete