Excel - Macro redondeo

Sub diccinario()

    On Error Resume Next

    Range("D2:E2").ClearContents

    Dim dict As Object

    Set dict = CreateObject("Scripting.Dictionary")

    Dim celda As Range, rng As Range

    uf = Range("A" & Rows.Count).End(xlUp).Row

    Set rng = Range("A2:A" & uf)

    valbuscado = Range("C2").Value '*******

    dict.Add valbuscado, 0

    pos = 1

    For Each celda In rng

        If Not dict.Exists(celda.Value) Then

            dict.Add celda.Value, pos

            pos = pos + 1

        End If

    Next celda

'    nummin = WorksheetFunction.Min(rng)

'    nummax = WorksheetFunction.Max(rng)

'

    'ordenar de menor a mayor

    Set dict = SortDictionaryByKey(dict)

    'imprimir

    posBuscado = dict(valbuscado)

    Range("D2").Value = dict.keys()(posBuscado - 2) 'menor

'    Actual = dict.keys()(posBuscado - 1)

    Range("E2").Value = dict.keys()(posBuscado + 0) 'mayor

End Sub

Public Function SortDictionaryByKey(dict As Object) As Object

    Dim arrList As Object

    Set arrList = CreateObject("System.Collections.ArrayList")

    ' Put keys in an ArrayList

    Dim key As Variant

    For Each key In dict

        arrList.Add key

    Next key

    ' Sort the keys

    arrList.Sort

    ' For descending order, reverse

    If sortorder = xlDescending Then

        arrList.Reverse

    End If

    ' Create new dictionary

    Dim dictNew As Object

    Set dictNew = CreateObject("Scripting.Dictionary")

    ' Read through the sorted keys and add to new dictionary

    pos = 1

    For Each key In arrList

        dictNew.Add key, pos 'dict(key)

        pos = pos + 1

    Next key

    ' Clean up

    Set arrList = Nothing

    Set dict = Nothing

    ' Return the new dictionary

    Set SortDictionaryByKey = dictNew

End Function