Значения, замененные в массиве, округляются при преобразовании обратно в Range

Question

Сначала я конвертирую диапазон в массив, которым манипулируют, в этом случае я заменяю некоторые элементы массива значениями из того же диапазона. Этот новый массив преобразуется обратно в новый диапазон (на другом листе) и представлен на следующем листе. Например, заменить элемент массива на 18,64 и преобразовать его обратно в новый диапазон, где он хранится / отображается как 19.

Sub test_array()

'On Error Resume Next
Application.ScreenUpdating = False
Dim StartTime As Double
Dim TimeTaken As Double
StartTime = Timer
Dim wb As Workbook
Set wb = ThisWorkbook
Dim myTable As String
Dim myRange As Range
Dim sArr As Variant
Dim MORange As Range
Dim i As Long
Dim j As Long

Dim MO As String
Dim off As Long
Dim WeaMat As Range
Dim WeaMatPath As String
Dim FindMO_1 As Range
Dim MOnachbar As String
Dim FindMO_2 As Range
Dim MOcol As Long
Dim Vneu As Long
Dim desRange As Range 'destination range = myRange IMMER!
Dim ZeitStempel As String
Dim FINOPath As String
Dim FINORange As Range
Dim FINDZeitStempel As Range
Dim VFINO As Long
Dim DateRange As Range
Dim ErrCnt As Long
Dim Target As Long
Dim UmAnlg As Long

'---------INPUTS----------
myTable = "C10:BP585" 'Hier die Table Range Eingeben
WeaMatPath = "C:\Users\Nikhil.srivatsa\Desktop\WeaMat" 'Hier den tatsächlichen Pfad eingeben
FINOPath = "C:\Users\Nikhil.srivatsa\Desktop\FINO raw-010119-310819_NS_20200327" 'Hier den tatsächlichen Pfad sowie die Datei Name, falls anders eingeben
Target = 1 'Hier die Werten die <= Target werden ersetzt
UmAnlg = 5 'Anzahl der umliegenden Anlagen
'-------------------------

Set MORange = wb.Worksheets("INPUT_WIND").Range("C2:BP2") 'Das ändert sich nie
Set myRange = wb.Worksheets("INPUT_WIND").Range(myTable) 'Immer anpassen
Set WeaMat = Workbooks.Open(WeaMatPath).Worksheets(1).Range("A:A")

Set DateRange = wb.Worksheets("INPUT_WIND").Range("B3:B" & CLng(Right(myTable, 3)))
Set FINORange = Workbooks.Open(FINOPath).Worksheets(1).Range("A:A") 'öffnet FINO Datei und legt die SuchRange fest!WICHTIG!Worksheetnummer entsprechend anpassen falls die Datei anders ist
wb.Sheets.Add(After:=wb.Worksheets("INPUT_WIND")).Name = "Ersetzt" ' create new sheet
Set desRange = wb.Worksheets("Ersetzt").Range(myTable) 'Range im neuen Sheet


DateRange.Copy wb.Worksheets("Ersetzt").Range("B3:B" & CLng(Right(myTable, 3))) 'Dates und MOs rüberkopieren
MORange.Copy wb.Worksheets("Ersetzt").Range("C2:BP2") 'Dates und MOs rüberkopieren
sArr = myRange.Value 'Creates Array of All cells
ErrCnt = 0
For i = LBound(sArr, 1) To UBound(sArr, 1) 'Rows
    For j = LBound(sArr, 2) To UBound(sArr, 2) 'Columns
      If sArr(i, j) <= Target Or IsEmpty(sArr) = True Then
      off = 1
      Do While off <= UmAnlg
         MO = MORange.Cells(1, j)
         'Debug.Print MO
         Set FindMO_1 = WeaMat.Find(MO, lookat:=xlWhole, LookIn:=xlValues, MatchCase:=False, SearchFormat:=False) 'Lookup MO in WEA MAtrix
         If Not FindMO_1 Is Nothing Then
         MOnachbar = FindMO_1.Offset(, off)
         'Debug.Print MOnachbar
         Else
         MsgBox "MOnachbar nicht gefunden"
         Exit Sub
         End If
         Set FindMO_2 = MORange.Find(MOnachbar, lookat:=xlWhole, MatchCase:=False, SearchFormat:=False) 'lookup MONachbar in INPUT_WIND
         If Not FindMO_2 Is Nothing Then
         MOcol = FindMO_2.Column - 2 'column Index für myRange
         Vneu = myRange.Cells(i, MOcol).Value
         Else
         MsgBox "FIND MOnachbar in INPUT_WIND hat nicht funktioniert"
         Exit Sub
         End If
         'Debug.Print Vneu
          If Vneu > Target And IsEmpty(Vneu) = False Then
             sArr(i, j) = Vneu 'array value wurde ersetzt
             desRange.Cells(i, j).AddComment.Text "Ersetzt durch" & " " & MOnachbar 'Kommentar
             desRange.Cells(i, j).Font.Bold = True 'Bold font
               Exit Do
          End If
          off = off + 1
          If off > 5 Then 'durch FINO daten ersetzen da mehr als 5 umliegende Anlagen entweder Blank oder 0 sind
          ZeitStempel = CStr(myRange.Cells(i, j).Offset(, -j)) 'als String / Text
          'Debug.Print ZeitStempel
            For Each C In FINORange
            If C = ZeitStempel Then
              ErrCnt = ErrCnt + 1
              VFINO = C.Offset(, 1).Value
              Exit For
              If ErrCnt > FINORange.Count Then
              Exit For
              End If
            End If
            Next C
            sArr(i, j) = VFINO
            desRange.Cells(i, j).AddComment.Text "Ersetzt durch" & " " & "FINO" 'Kommentar
            desRange.Cells(i, j).Font.Bold = True 'Bold font
              Exit Do
         End If
      Loop
      End If
   Next j
Next i

desRange.Value = sArr

'wb.Worksheets("Ersetzt").Range("C2").Select

Workbooks("WeaMat").Close False 'close WeaMat without saving
Workbooks("FINO raw-010119-310819_NS_20200327").Close False 'close FINO datei ohne sie zu spiechern
Application.Calculation = xlCalculationAutomatic
TimeTaken = Round((Timer - StartTime) / 60, 2)
Debug.Print TimeTaken

If Not ErrCnt > FINORange.Count Then
MsgBox "fertig in" & " " & TimeTaken & " " & "Minuten"
Else
MsgBox "fertig in" & " " & TimeTaken & " " & "Minuten" & " " & "Einige FINO Zeitstemmpeln wurden nicht gefunden"
End If
Application.ScreenUpdating = True

End Sub