0

I am finishing a project and seems like the last part is the most difficult.

I have 7 (6 + 1 optional) columns that have this sort data (some of them have only earlier/later/na, and some of them earlier/later/equals/na). For example three rows:

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

These can end in 13 different scenarios (if it's "ok ok no yes earlier earlier n/a" would come to for example "a = a + 1"). What I need is to actually count how many of each scenario happened (from "a" to "m"). Also for example if the first three columns are "OK OK OK" I dont need to consider the following conditions and straight add it to f.e. b = b + 1 and go to the next row.

My question here is how efficiently I can do that having in mind that I will have more than 50,000 rows? I understand that I could do that with IF, but I would just get lost in all the if's and I believe this will take a lot of time for macro to run through all the scenarios.

I appreciate all your help and support.

4

1 回答 1

0

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

它具有您可能想要更改的代码内置的假设，包括“解决方案”当前与数据位于同一工作表中（当前位于名为“场景”的工作表中，从 A 列和第 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
于 2014-10-16T22:57:29.060 回答