Option Explicit
'===========================================================================================
Sub ReplaceNotAll()
Dim rng As Range, ar As Range, AC&
Dim x, arr, r&, c&, n&, nR&
Const whatFind = 310, whatReplace = 500, nReplace& = 5 ' задаём константы: что ищем, на что меняем и сколько раз (0 - если все)

nR = nReplace: If nR = 0 Then nR = 2 * 10 ^ 6
Set rng = Selection
Application.ScreenUpdating = False
AC = Application.Calculation
Application.Calculation = xlCalculationManual

    For Each ar In rng.Areas
        arr = ar.Value2
        If IsArray(arr) Then
            For c = 1 To UBound(arr, 2)
                For r = 1 To UBound(arr, 1)
                    If arr(r, c) = whatFind Then
                        n = n + 1: If n > nR Then GoTo fin
                        arr(r, c) = whatReplace
                    End If
                Next r
            Next c
        Else
            If arr = whatFind Then
                n = n + 1: If n > nR Then GoTo fin
                arr = whatReplace
            End If
        End If
        ar.Value2 = arr
    Next ar

fin:
Application.ScreenUpdating = True
Application.Calculation = AC
End Sub

Option Explicit
'===========================================================================================
Sub ReplaceNotAll()
Dim rng As Range, ar As Range, AC&, t!
Dim arr, r&, c&, n&, nR&, flag As Boolean
Const whatFind = 310, whatReplace = 500, nReplace& = 3 ' задаём константы: что ищем, на что меняем и сколько раз (0 - если все)

t = Timer
nR = nReplace: If nR <= 0 Then nR = 2 * 10 ^ 6

Set rng = Selection
Application.ScreenUpdating = False
AC = Application.Calculation
Application.Calculation = xlCalculationManual

    For Each ar In rng.Areas
        arr = ar.Value2
        If IsArray(arr) Then
            For c = 1 To UBound(arr, 2)
                For r = 1 To UBound(arr, 1)
                    If Not flag And arr(r, c) = whatFind Then
                        n = n + 1: If n > nR Then flag = True Else arr(r, c) = whatReplace
                    End If
                Next r
            Next c
        Else
            If Not flag And arr = whatFind Then
                n = n + 1: If n > nR Then flag = True Else arr = whatReplace
            End If
        End If
        ar.Value2 = arr: If flag Then GoTo fin
    Next ar

fin:
Application.ScreenUpdating = True
Application.Calculation = AC

If n = 0 Then arr = "Значение «" & whatFind & "» отсутствует…" Else arr = "Произведено " & n & " замен(-а) «" & whatFind & "» на «" & whatReplace & "»"
MsgBox arr & vbLf & vbLf & "Время работы макроса: " & Format$(1000 * (Timer - t), "0.00 мс"), vbInformation, "ГОТОВО"
End Sub

Option Explicit
'===========================================================================================
Sub ReplaceNotAll()
Dim rng As Range, ar As Range, AC&, t!
Dim arr, r&, c&, n&, nR&
Const whatFind = 310, whatReplace = 500, nReplace& = 3 ' задаём константы: что ищем, на что меняем и сколько раз (0 - если все)

t = Timer
nR = nReplace: If nR <= 0 Then nR = 2 * 10 ^ 6

Set rng = Selection
Application.ScreenUpdating = False
AC = Application.Calculation
Application.Calculation = xlCalculationManual

    For Each ar In rng.Areas
        If ar.Count > 1 Then
            arr = ar.Value2
            For c = 1 To UBound(arr, 2)
                For r = 1 To UBound(arr, 1)
                    If arr(r, c) = whatFind Then
                        n = n + 1: If n > nR Then n = nR: ar.Value2 = arr: GoTo fin
                        arr(r, c) = whatReplace
                    End If
                Next r
            Next c
            ar.Value2 = arr
        Else
            If ar.Value2 = whatFind Then
                n = n + 1: If n > nR Then n = nR: GoTo fin
                ar.Value2 = whatReplace
            End If
        End If
    Next ar

fin:
Application.ScreenUpdating = True
Application.Calculation = AC

If n = 0 Then arr = "Значение «" & whatFind & "» отсутствует…" Else arr = "Произведено " & n & " замен(-а) «" & whatFind & "» на «" & whatReplace & "»"
MsgBox arr & vbLf & vbLf & "Время работы макроса: " & Format$(1000 * (Timer - t), "0.00 мс"), vbInformation, "ГОТОВО"
End Sub

let
    Source = Excel.CurrentWorkbook(){[Name="Source"]}[Content],
    Settings = Excel.CurrentWorkbook(){[Name="Settings"]}[Content],
    ToList = List.Buffer( List.Combine( Table.ToColumns( Source ) ) ),
    ColumnsCount = Table.ColumnCount( Source ),
    ItemCount = List.Count( ToList ),
    Search = Settings{0}[Что меняем],
    Replace = Settings{0}[На что меняем],
    CountMaxForReplace = List.Count( List.Select( ToList, each _ = Search) ),
    SearchCount = List.Min({ Settings{0}[Сколько значений], CountMaxForReplace }),
    Replacer = List.Generate(
                () => [id = 0, check = 0 + Number.From( ToList{id} = Search ), l = if ToList{id} = Search then Replace else ToList{id}],
                each [id] < ItemCount,
                each [id = [id] + 1, check = List.Min({ [check] + Number.From( ToList{id} = Search ), SearchCount}), l = if ToList{id} = Search and [check] < SearchCount then Replace else ToList{id}],
                each [l]
            ),
    Table = Table.FromColumns( List.Generate(
                () => [id = 0, l = List.Range(Replacer, 0, ItemCount / ColumnsCount)],
                each [id] < ColumnsCount,
                each [id = [id] + 1, l = List.Range(Replacer, id * ( ItemCount / ColumnsCount ), ItemCount / ColumnsCount)],
                each [l]
            ) )
in
    Table