Question

我是新手并且正在学习Excel VBA。我现在遇到这个问题

工作表中有超过10个表（表的数量不一致）
列数是一致的，但不是每个表中的行
我想在每张表的末尾应用一行
之后，我会将相同的公式应用于每个表，并将结果放在每个表的右侧

这可能很容易，但核心问题是范围未知。 - 因为它不是Excel中的实际表，所以我尝试首先通过为它创建表来定义数据的范围，然后再次，我不知道如何在不知道范围的情况下创建表。

以下是我想出的事情（这不是非常＆＃34;动态＆＃34;）

Sub plsWork()

Set u = ThisWorkbook.Worksheets("Sheet2")
Set f = u.Range("A").Find(what:="Name", lookat:=xlPart)
a = f.Address

Set sht = u.Range(a)

'trying to insert this at the end of the table
Total = Sum(u.Offset(2, 1) + u.Offset(3, 1) + u.Offset(4, 1))

If Cells(i, 2) = vbNullString Then 'this is already not applicable as the top 2 row in colB has null string
u.Offset(i, 1).Value = Total

'putting the table name at F2
u.Offset(-2, 5).Value = u.Offset(-3, 0).Value
u.Offset(-2, 6).Value = Total

u.Offset(-1, 5).Value = u.Offset(2, 0).Value
u.Offset(-1, 6).Value = Sum(u.Offset(2, 1) + u.Offset(2, 2) + u.Offset(2, 3))

u.Offset(0, 5).Value = u.Offset(3, 0).Value
u.Offset(0, 6).Value = Sum(u.Offset(3, 1) + u.Offset(3, 2) + u.Offset(3, 3))

u.Offset(1, 5).Value = u.Offset(4, 0).Value
u.Offset(1, 6).Value = Sum(u.Offset(4, 1) + u.Offset(4, 2) + u.Offset(4, 3))

End Sub

哦，当我在代码上面运行时，我收到错误＆＃34; Sub或Function not defined＆＃34;在＆＃34; SUM＆＃34;

Here is the image of the tables in a sheet
突出显示的黄色是执行sub后会出现的情况。

在Excel工作表中应用公式非常容易，并将公式复制粘贴到每个表中，
但它很乏味，所以我尝试提出一个vba代码来帮助，以便宏可以按计划运行。

过去两天我来回挠头，来回搜索，我还没有得到如何编码的线索。
那么任何专家都可以告诉我这是否可行？比如不知道范围？
如果是这样，你们可以告诉我一些如何实现这一目标的信息吗？谢谢。我真的想知道这是否可以做到。

Here is an image of my attempt using provided answer

Answer 1

您可以尝试这样的事情......

下面的代码将为每个表中插入一个Total Row，其中包含多行和四列。

Sub InsertTotalInEachTable()
Dim ws As Worksheet
Dim rng As Range
Dim i As Integer, r As Long, j As Long

Application.ScreenUpdating = False

Set ws = ActiveSheet

For Each rng In ws.UsedRange.SpecialCells(xlCellTypeConstants, 3).Areas
    If rng.Rows.Count > 1 And rng.Columns.Count = 4 Then
        j = 2
        r = rng.Cells(rng.Rows.Count, 1).Row + 1
        Cells(r, rng.Columns(1).Column).Value = "Total"
        For i = rng.Columns(2).Column To rng.Columns(2).Column + 2
            Cells(r, i).Formula = "=SUM(" & rng.Columns(j).Address & ")"
            j = j + 1
        Next i
    End If
Next rng
Application.ScreenUpdating = True
End Sub

Excel VBA：将公式分配给同一工作表

1 个答案: