Option Explicit
Option Base 1
Dim notemptyrng As Boolean
Function customPercentile(myrng As Range, myval As Double) As Variant
Dim Data() As Double
Dim i As Long, j As Long, nearestRank As Long
If isRangeEmpty(myrng) = False Then
customPercentile = "Input Range is Empty"
Exit Function
End If
If (myval < 0 Or myval > 100) Then
customPercentile = "Percentile must be between 0& 100"
End If
ReDim Data(myrng.Rows.Count * myrng.Columns.Count)
For i = 1 To myrng.Rows.Count
For j = 1 To myrng.Columns.Count
If IsNumeric(myrng.Cells(i, j)) = True Then
Data(i * j) = myrng.Cells(i, j)
Else
customPercentile = "Error exists in" & myrng.Cells(i, j).Address
Exit Function
End If
Next
Next
Call myBubbleSort(Data)
nearestRank = Round(myval / 100 * (myrng.Rows.Count * myrng.Columns.Count) + 0.5, 0)
Select Case myval
Case 0: customPercentile = Data(1)
Case Else: customPercentile = Data(nearestRank)
End Select
End Function
Function isRangeEmpty(myrng1 As Range) As Boolean
notemptyrng = False
If Application.WorksheetFunction.CountA(myrng1) > 0 Then
notemptyrng = True
End If
isRangeEmpty = notemptyrng
End Function
Function myBubbleSort(myArray() As Double) As Variant
Dim i As Long
Dim j As Long
Dim tempval As Variant
For i = LBound(myArray) To UBound(myArray) - 1
For j = i + 1 To UBound(myArray)
If myArray(i) > myArray(j) Then
tempval = myArray(j)
myArray(j) = myArray(i)
myArray(i) = tempval
End If
Next
Next
End Function
Option Base 1
Dim notemptyrng As Boolean
Function customPercentile(myrng As Range, myval As Double) As Variant
Dim Data() As Double
Dim i As Long, j As Long, nearestRank As Long
If isRangeEmpty(myrng) = False Then
customPercentile = "Input Range is Empty"
Exit Function
End If
If (myval < 0 Or myval > 100) Then
customPercentile = "Percentile must be between 0& 100"
End If
ReDim Data(myrng.Rows.Count * myrng.Columns.Count)
For i = 1 To myrng.Rows.Count
For j = 1 To myrng.Columns.Count
If IsNumeric(myrng.Cells(i, j)) = True Then
Data(i * j) = myrng.Cells(i, j)
Else
customPercentile = "Error exists in" & myrng.Cells(i, j).Address
Exit Function
End If
Next
Next
Call myBubbleSort(Data)
nearestRank = Round(myval / 100 * (myrng.Rows.Count * myrng.Columns.Count) + 0.5, 0)
Select Case myval
Case 0: customPercentile = Data(1)
Case Else: customPercentile = Data(nearestRank)
End Select
End Function
Function isRangeEmpty(myrng1 As Range) As Boolean
notemptyrng = False
If Application.WorksheetFunction.CountA(myrng1) > 0 Then
notemptyrng = True
End If
isRangeEmpty = notemptyrng
End Function
Function myBubbleSort(myArray() As Double) As Variant
Dim i As Long
Dim j As Long
Dim tempval As Variant
For i = LBound(myArray) To UBound(myArray) - 1
For j = i + 1 To UBound(myArray)
If myArray(i) > myArray(j) Then
tempval = myArray(j)
myArray(j) = myArray(i)
myArray(i) = tempval
End If
Next
Next
End Function
No comments:
Post a Comment