こんにちは　お世話になります。

お時間ございます方，ぜひご教示ください。

MAXIFSとMINIFS関数のマクロの書き方で教えて下さい。

こちらの掲示板やネットで調べて、下記のマクロを書きました。

データ量が20万行ほど有るからか、PCのスペックの問題なのか？
関数だとフリーズしてしまい、この書き方なら早くフリーズしにくいと言う思ってたからです。

Sub 最小最大()

   Dim LastRow As Long

   Sheets("処理").Select
    LastRow = Range("B" & Rows.Count).End(xlUp).Row 
                
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual 
 
 '埋め込み数式
Range("Y2:Y" & LastRow) = "=MAXIFS($D$2:D2,$AC$2:$AC2,$AC2)"
Range("Y2:Y" & LastRow).Value = Range("Y2:Y" & LastRow).Value


Range("AA2:AA" & LastRow) = "=MINIFS($D$2:D2,$AC$2:$AC2,$AC2)"
Range("AA2:AA" & LastRow).Value = Range("AA2:AA" & LastRow).Value 

           
   Application.ScreenUpdating = True
   Application.Calculation = xlCalculationAutomatic  

   
   End Sub

ですが、実際マクロを実行するとフリーズしてしまいます。
30分位待っても変わらないので強制終了してます。

どの様に書けばフリーズしなくなるか、コードを教えて頂ければ幸いです。
よろしくお願いします。

> データ量が20万行

ということは、20万個の式を埋め込んで計算させているということ。
さらに最後に式は、
=MAXIFS($D$2:D200000,$AC$2:$AC200000,$AC200000)
となり、20万のデータの中から最大値を探す処理になります。

当然重くなりますね。

とりあえず100行ぐらいのデータで試してみて、希望の結果になるか確認してみては。

配列と辞書(Dictionary)を使って作成してみました。


Sub 最小最大1()
    Dim LastRow As Long
    Sheets("処理").Select
    LastRow = Range("B" & Rows.Count).End(xlUp).Row

    Dim ary1(), ary2(), aryMax(), aryMin()
    ary1 = Range("D2:D" & LastRow).Value '検索対象範囲を配列へ
    ary2 = Range("AC2:AC" & LastRow).Value '条件範囲を配列へ
    ReDim aryMax(1 To UBound(ary1), 1 To 1) '最大値格納用配列
    ReDim aryMin(1 To UBound(ary1), 1 To 1) '最小値格納用配列
 
    Dim dicMax As Object, dicMin As Object
    Set dicMax = CreateObject("Scripting.Dictionary") '最大値判定用
    Set dicMin = CreateObject("Scripting.Dictionary") '最小値判定用
 
 
    Dim i As Long
    For i = 1 To UBound(ary1)
        If dicMax.exists(ary2(i, 1)) = True Then
            If dicMax(ary2(i, 1)) < ary1(i, 1) Then
                dicMax(ary2(i, 1)) = ary1(i, 1)
            End If
        Else
            dicMax.Add ary2(i, 1), ary1(i, 1)
        End If
        aryMax(i, 1) = dicMax(ary2(i, 1))

        If dicMin.exists(ary2(i, 1)) Then
            If dicMin(ary2(i, 1)) > ary1(i, 1) Then
                dicMin(ary2(i, 1)) = ary1(i, 1)
            End If
        Else
            dicMin.Add ary2(i, 1), ary1(i, 1)
        End If
        aryMin(i, 1) = dicMin(ary2(i, 1))
    Next
 
    Range("Y2").Resize(UBound(aryMax)).Value = aryMax
    Range("AA2").Resize(UBound(aryMin)).Value = aryMin

End Sub

いきなり20万行で試さずに、1000ぐらいから初めて、増やしていってみてください。

この記事にはVBAのコードが含まれています。

<FONT COLOR='green'>緑の太文字→注釈
<FONT COLOR='brown'>茶色の太文字→条件分岐
<FONT COLOR='red'>赤の太文字→ループ
<FONT COLOR='BLUE'>青の太文字→その他


この記事にはVBAのコードが含まれています。

緑の太文字→注釈
茶色の太文字→条件分岐
赤の太文字→ループ
青の太文字→その他