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种不同的场景中结束（如果它＆＃34;好的，不是先前早些时候n / a＆＃34;例如＆＃34; a = a + 1＆＃34; ）。我需要的是实际计算每个场景发生的次数（从＆＃34; a＆＃34;到＃34; m＆＃34;）。例如，如果前三列是＆＃34; OK OK OK＆＃34;我不需要考虑以下条件并将其直接添加到f.e. b = b + 1并转到下一行。

我的问题是，考虑到我将拥有超过50,000行，我能做得多么有效率？我知道我可以用IF做到这一点，但我会迷失在所有的if中，并且我相信宏需要花费大量时间来贯穿所有场景。

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

Answer 1

好的，这是使用VBA中的Excel SubTotal函数

的启动器

它有内置于您可能想要更改的代码的假设，包括＆＃39;解决方案＆＃39;当前与数据位于同一工作表中（当前位于名为＆＃34; Scenarios＆＃34;的工作表中，从col A和第7行开始）。这适用于有限数量的数据，但价值为5万行！您可以添加代码以根据需要汇总统计信息并删除小计。它保留了原始数据。

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

EXCEL VBA：如何计算场景？

1 个答案: