EXCEL VBA：如何计算场景？

Question

我正在完成一个项目，似乎最后一部分是最困难的。

我有 7 个（6 + 1 个可选）列具有这种排序数据（其中一些只有早/晚/na，其中一些只有早/晚/等于/na）。例如三行：

OK OK       No  Yes Earlier Earlier N/A
OK OK       No  Yes Earlier Earlier Earlier
OK Missed   Yes Yes Later   Later   Earlier

这些可以在 13 种不同的情况下结束（如果它是“ok ok no yes early n/a”，例如“a = a + 1”）。我需要的是实际计算每种情况发生了多少（从“a”到“m”）。另外例如，如果前三列是“OK OK OK”，我不需要考虑以下条件并将其直接添加到 f.e. b = b + 1 并转到下一行。

我的问题是，考虑到我将拥有超过 50,000 行，我能做到这一点的效率如何？我知道我可以用 IF 做到这一点，但我会迷失在所有的 if 中，而且我相信这需要很长时间才能让宏运行所有场景。

感谢您的所有帮助和支持。

Answer 1

好的，这是在 VBA 中使用 Excel SubTotal 函数的初学者

它具有您可能想要更改的代码内置的假设，包括“解决方案”当前与数据位于同一工作表中（当前位于名为“场景”的工作表中，从 col A 和 row 开始7）。这适用于有限数量的数据，但价值 50k 行！您可以根据需要添加代码来汇总统计数据并删除小计。它使原始数据保持不变。

Sub scenarios()
Dim ws As Worksheet
Dim strow As Long, endrow As Long, stcol As Long, endcol As Long
Dim r As Long, c As Long
Dim newstr As String
Dim cl As Range, rng As Range, drng As Range
Dim strArr() As String

strow = 7
stcol = 1  'Col A
endcol = 7 '7 variables

Set ws = Sheets("Scenarios")

    With ws
        'find last data row
        endrow = Cells(Rows.Count, stcol).End(xlUp).Row
            'for each data row
            For r = strow To endrow
                newstr = ""
                'produce concatenated string of that row
                For c = stcol To endcol
                    newstr = newstr & .Cells(r, c)
                Next c
                'put string into array
                ReDim Preserve strArr(r - strow)
                strArr(r - strow) = newstr
            Next r
        'put array to worksheet
        Set drng = .Range(.Cells(strow, endcol + 4), .Cells(endrow, endcol + 4))
        drng = Application.Transpose(strArr)
        'sort newly copied range
        drng.Sort Key1:=.Cells(strow, endcol + 4), Order1:=xlAscending, Header:=xlNo

        'provide a header row for SubTotal
        .Cells(strow - 1, endcol + 4) = "Header"
        'resize range to include header
        drng.Offset(-1, 0).Resize(drng.Rows.Count + 1, drng.Columns.Count).Select
        'apply Excel SubTotal function
        Selection.Subtotal GroupBy:=1, Function:=xlCount, Totallist:=Array(1)

    End With

End Sub