重複配列の取得と、各配列ごとの平均値取得（動的配列、UBound、Dictionary　使用）

‘重複品番のうち、価格が同じはOKと判断する。
‘配列に重複品番を格納
Dim Dic As Object, buf As String
Dim Arr() As String: ReDim Arr(0) ‘Index 0で初期化
Dim sum下代 As Currency, ave下代 As Currency
Dim rowNo As Long, i As Long, k As Long, m As Long
Dim LastRow As Long

‘ s1 = “新規メニュー予定”
LastRow = Worksheets(s1).Cells(Rows.Count, 14).End(xlUp).Row ‘N列（モダンブルー品番）最終行番号取得

Set Dic = CreateObject("Scripting.Dictionary")

With Worksheets(s1)
    For i = 4 To LastRow

        If .Range("A" & i) = "重複" Then

            buf = .Range("N" & i).Value         ''セルの値を変数bufに格納する
            If Not Dic.Exists(buf) Then     ''まだ登録されていなかったら…

                Dic.Add buf, buf  ''セルの値を連想配列に登録する

                'Arrへの格納時に、添え字の数値指定ではなくUboundで最大要素に追加する。
                 Arr(UBound(Arr)) = .Range("N" & i).Value

                 '拡張
                 ReDim Preserve Arr(UBound(Arr) + 1)

            End If

        End If

    Next i

    '1つ余分に作ってしまうので削除
    ReDim Preserve Arr(UBound(Arr) - 1)

    MsgBox Dic.Count & "件の品番が重複しています。"

    '重複品番の各品番ごとに下代の平均値を算出し、それに下代の金額が合致していたら問題ないと判定し、「重複」⇒「OK」に変更する
    For i = 0 To Dic.Count - 1

        sum下代 = 0
        m = 0
        For k = 4 To LastRow
            '重複品番のある行数を取得
            If .Range("N" & k).Value = Arr(i) Then
                '下代（U列）の合計を算出
                sum下代 = sum下代 + .Range("U" & k).Value
                m = m + 1
            End If
        Next k

        ave下代 = sum下代 / m

        For k = 4 To LastRow
            '重複品番のある行数を取得
            If .Range("N" & k).Value = Arr(i) And .Range("U" & k).Value = ave下代 Then
                .Range("A" & k).Value = "OK"

                '背景色とフォントカラーを通常に戻す。
                .Range("A" & k).Interior.Color = RGB(255, 255, 255)
                .Range("A" & k).Font.Color = RGB(0, 0, 0)
                .Range("Q" & k).Interior.Color = RGB(255, 255, 255)
                .Range("R" & k).Interior.Color = RGB(255, 255, 255)
                .Range("U" & k).Interior.Color = RGB(255, 255, 255)


            End If
        Next k

    Next
    MsgBox "重複品番については、下代の金額が合致していた場合、" & vbCrLf & "問題ないと判定しますので、A列を「OK」に変更いたします。"

End With

'-----検証----

Debug.Print "----"

For i = 0 To UBound(Arr)
    Debug.Print Arr(i)
Next i
Debug.Print "----"

Set Dic = Nothing

参考文献

★動的配列：UBound
Office TANAKA - Excel VBA関数[UBound]
officetanaka.net