Nhờ anh chị sửa dùm em code VBA

[heyhey1994]

Sub Taodayso()

Range("C22:U9999").Select
Selection.Delete Shift:=xlUp

Dim sArr, dArr, sRng As Range, eRng As Range
Dim Dic As Object
Dim i As Long, K As Long, j As Long, Col As Long, N As Long, Nt As Long, Ns As Long, sodong As Long, demdong As Long, t As Long
On Error GoTo Thoat
Set Dic = CreateObject("Scripting.Dictionary")
Set sRng = Sheet1.Range("X22:Y99")
N = 2
sArr = sRng.Value
ReDim dArr(1 To 65535, 1 To UBound(sArr, 2))
For i = 1 To UBound(sArr)
If Not Dic.Exists(sArr(i, N)) Then
Dic.Add sArr(i, N), ""
If sArr(i, N) <> Empty Then
If sArr(i, 1) >= 1 Then
If i = 1 Then Nt = 1
Ns = Int(sArr(i, N))
For j = Nt To Ns
K = K + 1
For Col = 1 To N - 1
dArr(K, Col) = sArr(i, Col)
Next Col
dArr(K, N) = j
Next j
End If
If sArr(i, N) > Int(sArr(i, N)) Then
K = K + 1
For Col = 1 To N - 1
dArr(K, Col) = sArr(i, Col)
Next Col
dArr(K, N) = sArr(i, N)
End If
Nt = Ns + 1
End If
End If
Next i
Set eRng = Sheet1.Range("C22:D22")
eRng.Resize(1500, UBound(sArr, 2)).ClearContents
eRng.Resize(K, UBound(sArr, 2)) = dArr
Set Dic = Nothing
Thoat:
Trong đây là bản VBA em tìm trên mạng chia dãy số cho trước thành 1 đoạn nhỏ nhưng nó chỉ chia cho từng đoạn 1. Ví dụ 5.3 thành 1 1 1 1 1.3. Có cách nào sửa code này để chia thành đoạn 0.5 hoặc 2 ... tùy mình chỉnh được ko ạ.
em cảm ơn.