0

私はプロジェクトを終えていますが、最後の部分が最も難しいようです。

この並べ替えデータを持つ 7 (6 + 1 オプション) の列があります (そのうちのいくつかは以前/後で/na しかなく、いくつかは以前/後で/等しい/na)。たとえば、3 つの行:

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 いいえ はい 以前は N/A」の場合は、たとえば「a = a + 1」になります)。私が必要としているのは、実際に発生した各シナリオの数 (「a」から「m」まで) を数えることです。また、たとえば、最初の 3 列が「OK OK OK」の場合、次の条件を考慮する必要はなく、そのまま fe b = b + 1 に追加して次の行に進みます。

ここでの私の質問は、50,000 行を超えることを念頭に置いて、どれだけ効率的にそれを行うことができるかということです。IF を使用してそれを実行できることは理解していますが、すべての if で迷子になるだけであり、マクロがすべてのシナリオを実行するには多くの時間がかかると思います。

皆様のご支援とご支援に感謝いたします。

4

1 に答える 1

0

OK、これは VBA 内で Excel の SubTotal 関数を使用するスターターです

「ソリューション」が現在データと同じシートにあることを含め、変更したいコードに組み込まれた仮定があります（現在、列Aと行7から始まる「シナリオ」と呼ばれるシートにあります）。これは限られた量のデータで機能しますが、50,000 行に相当します! 必要に応じて統計を要約するコードを追加し、小計を削除できます。元のデータはそのまま残ります。

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 に答える