首页 > 解决方案 > 如何从表格上方的单元格中创建一个范围?

问题描述

我的表格/范围标题行正上方的行中有公式。我想复制公式值并将它们粘贴到表格/范围的最后(新)行。我知道如何使代码工作,除了对带有公式的行的引用。

这是我试图引用表格中第一个单元格上方两行的单元格的代码(我将其设置/定义为范围)。

Set rangeTopLeft = rangeActive.Cells(1, 1).Offset(-2)

我收到 1004 错误。

我继续通过调整大小来创建范围,rangeTopLeft并执行其他步骤以将值从公式复制并粘贴到新行。

如果我使用 ,我不会收到错误消息.Offset(-1),但这只会让我进入标题行中的第一列单元格。我猜,偏移量不能超出范围的边界。

'Paste Last Week's Formula Values to New Rows

Sub PasteValues()

Dim rangeList As Range
Dim rangeActive As Range
Dim rangeToCopy As Range
Dim lastRow As Range
Dim rangeName As String

Dim rowNumber As Integer
Dim dataBeginColumn As Integer
Dim actionColumn As Integer
Dim actionType As String

Dim nameColumn As Integer
Dim dataColumnFirst As Integer
Dim dataColumnLast As Integer

Dim response1 As VbMsgBoxResult
Dim response2 As VbMsgBoxResult

Set rangeList = Range("tTablesDetails").ListObject.DataBodyRange

nameColumn = 1
actionColumn = 7
actionType = "Append"

'Requires user to click "Yes" twice before pasting values
response1 = MsgBox("Do you want to past last week's formula values to tables of this Workbook?", vbYesNo + vbCritical)
If response1 = vbNo Then Exit Sub
    
response2 = MsgBox("Are you sure? This action cannot be undone.", vbYesNo + vbCritical)
        
If response2 = vbNo Then Exit Sub
      
For rowNumber = 1 To rangeList.Rows.Count
        
    If rangeList.ListObject.DataBodyRange(rowNumber, actionColumn).Value = actionType Then
        
        'get table name from row whose action column equals actiontype
        rangeName = rangeList.ListObject.DataBodyRange(rowNumber, nameColumn).Text
            
        Set rangeActive = Range(rangeName)
            
        Set rangeTopLeft = rangeActive.Cells(1, 1).Offset(-2)
                
        Set rangeToCopy = rangeTopLeft.Resize(1, rangeActive.Columns.Count)
            
        Set lastRow = rangeActive.Offset(rangeActive.Rows.Count).Resize(1, rangeActive.Columns.Count)
            
        lastRow = rangeToCopy.Value
                   
    End If
     
Next
     
MsgBox ("Finished Copying Values to New Rows")
    
End Sub

更新:我用下面的代码片段解决了这个问题。

tableList是一个 Range 对象,由工作簿中的表格组成,列出工作簿中各个表格的详细信息。Range 对象不需要指定表格所在的工作表。

For rowNumber = 1 To tableList.Rows.Count
    If tableList.Item(rowNumber, actionColumn).Value = actionType Then
        tableName = tableList.Item(rowNumber, nameColumn).Value
        Set activeTable = Range(tableName)
        With activeTable
            .Rows(.Rows.Count + 1).Value = activeTable.Rows(-1).Value
        End With
    End If
Next

标签: excelvba

解决方案


使用 a 的内置属性ListObject,特别是HeaderRowRange.

并且无需调整大小然后复制/粘贴值,您只需将值从上方的行转移HeaderRowRange到新添加的ListRow.

也许是这样的:

Sub Test()
    Dim myTable As ListObject
    Set myTable = Sheet1.ListObjects("Table1")

    Dim formulaRange As Range
    Set formulaRange = myTable.HeaderRowRange.Offset(-1)

    myTable.ListRows.Add.Range.Value = formulaRange.Value
End Sub

推荐阅读