在VBA中,如何在表格上方的单元格之外创建范围?

时间:2018-11-16 16:43:45

标签: excel vba excel-vba

更新:我使用以下代码片段解决了此问题。谢谢大家的帮助。 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

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

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

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

尝试运行VBA代码时出现1004错误。

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

如果我使用.Offset(-1)不会出现错误,但这只会使我进入标题行的第一列单元格。我猜想,偏移一定不能超出范围的范围。

假设是这样(或其他),我该如何解决?

谢谢。

好的,请避免使用“新手”。我可以正常使用后再清理。

'     “将上周的公式值粘贴到新行中

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'

2 个答案:

答案 0 :(得分:3)

使用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

答案 1 :(得分:1)

Sub SO()
    Dim lst As ListObject
    Set lst = ActiveSheet.ListObjects("Table1")
    With lst.DataBodyRange
        .Rows(.Rows.Count + 1).Value = .Rows(1).Offset(-2).Value
    End With
End Sub