使用 VBA 的特定小计

Posted 2023-05-08

【中文标题】使用 VBA 的特定小计

【英文标题】：Specific subtotals using VBA

【发布时间】：2019-02-08 13:53:20

【问题描述】：

以上是我从数据库中提取的输入数据示例。 A 列有多个级别（命名为 L1、L2、L3、L4、L5）。 B 列有值。它的运作方式是， L2 = 它上面所有 L1 的总和，直到你遇到上面的另一个 L2。 L3 = 上面所有 L2 的总和，直到你遇到上面的另一个 L3。

L4 类似。最后一级是 L5，它具有列中所有 L4 的总和。

此外，有时会有一个独立的 L2（没有可用的 L1 分解详细信息），必须按原样考虑。示例 – 单元格 B10，其独立值为 2，在单元格 B9 中紧接着在其上方有另一个 L2，它是其上方 L1 的总和

问题是有时数据不正确，L2 可能不是其上方所有 L1 的总和（就像数据库可能遗漏了 L1 行）。如果发生此类错误，我需要在 C 列中进行验证。

因此，如果没有错误，我在 C 列中的输出应该与 L2、L3、L4、L5 的 B 列具有相同的值。或者不同的值，如果有错误。

该范围是动态的，并且包含数百行。

任何宏或预先存在的 excel 公式都可以做到这一点？

如果我能针对这个问题获得任何帮助/代码或指针，我将不胜感激。

以下是我创建的部分代码。 cmets 部分需要您的帮助。感谢您的帮助。

Sub Ttals()
lastrow = Worksheets("EMEA").Cells(Rows.Count, "AB").End(xlUp).Row
Debug.Print lastrow
For i = 2 To lastrow
If Cells(i, 1) = "L1" Then
    Cells(i, 3) = Cells(i, 2) 'This is pasting L1 values from column B/2 to column C/3

ElseIf Cells(i, 1) = "L2" Then
'Insert a function to search rows above this cell for values:
'If immediately above - L2/L3/L4/L5/L6 are encountered, paste value from column B/2 for this row
'If immediately above L1 is encountered, keep going above till more L1 are encoutered,
'and when any other L are encountered, stop going up and take a sum of all L1 in this range and post the sum

ElseIf Cells(i, 1) = "L3" Then
'Insert similar function which I can modify myself once I get the above function for L2

End If
Next
End Sub

【问题讨论】：

这不是更多的数据库问题吗？我可能对数据的来源感到困惑，但似乎修复源查询比尝试“按摩”从它那里得到的坏数据更有意义。

嗨@Comintern - 很好的观察。但是，我无法控制数据库，因此，我必须在最后进行这些检查。

【参考方案1】：

您可以使用以下公式：

=IF(VALUE(RIGHT(A1,1))>1,IF(COUNTIFS(INDIRECT("A1:A"&ROW()),A1)=1,SUMIFS(INDIRECT("B1:B"&ROW()),INDIRECT("A1:A"&ROW()),"L"&VALUE(RIGHT(A1,1))-1),SUMIFS(INDIRECT("B"&LARGE(IF($A$1:INDIRECT("A"&ROW())=A1,ROW($A$1:INDIRECT("A"&ROW()))-MIN(ROW($A$1:INDIRECT("A"&ROW())))+1),2)&":B"&ROW()),INDIRECT("A"&LARGE(IF($A$1:INDIRECT("A"&ROW())=A1,ROW($A$1:INDIRECT("A"&ROW()))-MIN(ROW($A$1:INDIRECT("A"&ROW())))+1),2)&":A"&ROW()),"L"&VALUE(RIGHT(A1,1))-1)),B1)

尝试了不同的方法来检查上面行的值，但数组公式已经变得更好，所以下面是对 0 的检查：

=IF(IF(VALUE(RIGHT(A1,1))>1,IF(COUNTIFS(INDIRECT("A1:A"&ROW()),A1)=1,SUMIFS(INDIRECT("B1:B"&ROW()),INDIRECT("A1:A"&ROW()),"L"&VALUE(RIGHT(A1,1))-1),SUMIFS(INDIRECT("B"&LARGE(IF($A$1:INDIRECT("A"&ROW())=A1,ROW($A$1:INDIRECT("A"&ROW()))-MIN(ROW($A$1:INDIRECT("A"&ROW())))+1),2)&":B"&ROW()),INDIRECT("A"&LARGE(IF($A$1:INDIRECT("A"&ROW())=A1,ROW($A$1:INDIRECT("A"&ROW()))-MIN(ROW($A$1:INDIRECT("A"&ROW())))+1),2)&":A"&ROW()),"L"&VALUE(RIGHT(A1,1))-1)),B1)=0,B1,IF(VALUE(RIGHT(A1,1))>1,IF(COUNTIFS(INDIRECT("A1:A"&ROW()),A1)=1,SUMIFS(INDIRECT("B1:B"&ROW()),INDIRECT("A1:A"&ROW()),"L"&VALUE(RIGHT(A1,1))-1),SUMIFS(INDIRECT("B"&LARGE(IF($A$1:INDIRECT("A"&ROW())=A1,ROW($A$1:INDIRECT("A"&ROW()))-MIN(ROW($A$1:INDIRECT("A"&ROW())))+1),2)&":B"&ROW()),INDIRECT("A"&LARGE(IF($A$1:INDIRECT("A"&ROW())=A1,ROW($A$1:INDIRECT("A"&ROW()))-MIN(ROW($A$1:INDIRECT("A"&ROW())))+1),2)&":A"&ROW()),"L"&VALUE(RIGHT(A1,1))-1)),B1)

注意这是一个数组公式！像这样粘贴到 cel C1 中并向下拖动。

这是一个相当长的：P

【讨论】：

您好 JvdV，感谢您提供详细的数组公式并如此迅速地回复。我在工作表上运行了公式，虽然它大部分工作正常，但它不能计算连续的 L2，比如单元格 C10 仍然反映 0 而不是 2。 PS：如果您尝试重新运行公式，请更正错误最后一节中的“RICHT”到“RIGHT”。此外，如果在“L”和“1”之间拆分 L1 是一件苦差事，我可以在工作表中轻松地将 L1 更改为 1/ L2 为 2 等等，以使其更容易。再次感谢您的帮助。

我可能很快就会再看一遍。附：错字是因为我正在使用荷兰语函数名称，必须在之后翻译它们:)

嗨@JvdV 注意到。你有没有机会修改公式？我正在尝试添加另一个 If 条件，但它不起作用。谢谢。

@dark_horizo​​n，我花了一些时间尝试了不同的方法，但最简单的方法是检查上面的公式是否返回0。所以添加一个IF 语句，如：=IF(...full above formula...=0,B1,...again the full formula from above)

感谢您的代码。它完美地工作。我很惊讶如此复杂的计算仅通过公式而不是宏来完成。你是个天才。希望有一天我能有机会帮助你。再次感谢。