Question

我在工作表上设置了命名范围。它被称为ProjData。我的VB代码可以按字母顺序插入新行。我被困的地方是在命名范围的顶部或命名范围的底部添加新行。我在range.insert上尝试了很多次迭代，但是我无法在顶部或底部添加行。该行始终在指定范围之前或之后插入工作表行。

这是我的代码。

Public Sub test()
Dim rng As Range
Dim aNumber As Variant
Dim rowNum As Variant
Dim iRows As Integer

aNumber = "Orange"

Set rng = Worksheets("Overview").Range("ProjData")

iRows = rng.Rows.Count
If iRows = 1 And rng(1, 1).Value = "" Then
    'rng.Rows(rowNum).Insert shift:=xlDown
    'rng.Rows(rowNum).Copy rng.Rows(rowNum + 1)
    rng(1, 1).Value = aNumber
    For x = 2 To 19
            rng(1, x).Formula = "=now()"
        Next x
    Exit Sub
End If

rowNum = Application.Match(aNumber, rng.Columns(1), 1)

If Not IsError(rowNum) Then
    rng.Rows(rowNum + 1).Insert shift:=xlDown
    rng.Rows(rowNum).Copy rng.Rows(rowNum + 1)
    rng(rowNum + 1, 1).Value = aNumber
Else
    rng.Rows(1).Insert shift:=xlDown

    rng.Rows(2).Copy rng.Rows(1)
    rng(1, 1).Value = aNumber

End If

End Sub

谢谢，富

Answer 1

我自己必须解决一个类似的问题。像您一样，我发现在范围中的两个现有行之间插入新行的效果很好，但是将行插入范围的第一行上方，并将行插入范围的底部行下方并不会改变范围的大小包括它们。

基于a relevant answer on the MrExcel.com forums，为了将新行包括在范围内，您似乎需要：

创建原始范围的副本
使用以下命令调整新范围的大小偏移和调整大小方法，以包括新行
分配原件范围名称更改为新范围

我已经基于此逻辑编写了两个函数，以将行添加到范围的开头或结尾。请仔细阅读注释，了解我如何应用逻辑，希望代码有用。

Function InsertRowAtStartOfNamedRange(sheet As Worksheet, rangeName As String) As Integer
    Dim firstRowOfRange As Range, newRow As Range, workingRange As Range
    
    With sheet.Range(rangeName)
        ' Get the first row of the named range.
        Set firstRowOfRange = .Rows(1).EntireRow
        ' Insert the new row above the first row of the named range.
        firstRowOfRange.Insert xlShiftDown
        ' Set the new row range so we can return the row number from this function.
        Set newRow = firstRowOfRange.Offset(rowOffset:=-1)
        ' Assign a copy of the offset and resized range to workingRange.
        Set workingRange = .Offset(rowOffset:=-1)
        Set workingRange = workingRange.Resize(rowSize:=.Rows.Count + 1)
    End With
    
    ' Change the named range to use workingRange's resized range by assigning the range name.
    workingRange.Name = rangeName
    
    ' Return the row number from the function.
    InsertRowAtStartOfNamedRange = newRow.Row
    
End Function


Function InsertRowAtEndOfNamedRange(sheet As Worksheet, rangeName As String) As Integer
    Dim lastRowOfRange As Range, newRow As Range, workingRange As Range
    
    With sheet.Range(rangeName)
        ' Get the last row of the named range.
        Set lastRowOfRange = .Rows(rowIndex:=.Rows.Count).EntireRow
        ' Insert the new row from the row below the last row of the named range.
        lastRowOfRange.Offset(rowOffset:=1).Insert xlShiftDown
        ' Set the new row range so we can return the row number from this function.
        Set newRow = lastRowOfRange.Offset(rowOffset:=1)
        ' Assign a copy of the resized range to workingRange.
        Set workingRange = .Resize(rowSize:=.Rows.Count + 1)
    End With
    
    ' Change the named range to use workingRange's resized range by assigning the range name.
    workingRange.Name = rangeName
    
    ' Return the row number from the function.
    InsertRowAtEndOfNamedRange = newRow.Row
    
End Function

Answer 2

此代码将在命名范围的指定行之前添加一个新行，然后调整命名范围的大小以包括新插入的行

（例如，如果您的命名范围是$A$4:$B$17，则$A$4:$B$4是第1行，而$A$17:$B$17是第14行，或第15行将行添加到命名范围的末尾）

Public Function NamedRange_AddRow(Target As Name, InsertAt As Long) As Boolean
    'Target: Named Range to insert Row to.
    'InsertAt: Row of the Named Range to insert the Row before;
    '    If this is 1 larger than the count of Rows, the new row will be added to the end
    NamedRange_AddRow = False
    On Error GoTo ExitFunction
    
    Dim InsertRange As Range, CurrentRows As Long
    
    CurrentRows = Target.RefersToRange.Rows.Count
    
    If (InsertAt < 1) Or (InsertAt > (CurrentRows + 1)) Then Exit Function
    
    Target.RefersToRange.Rows(InsertAt).Offset(IIf(InsertAt > CurrentRows, 1, 0), 0).Insert xlShiftDown
    
    Target.RefersTo = Target.RefersToRange.Offset(IIf(InsertAt = 1, -1, 0), 0).Resize(CurrentRows + 1)
    
    NamedRange_AddRow = True
ExitFunction:
End Function

如何在命名范围的顶部或底部插入新行

2 个答案: