[Chia sẻ] Hàm UDF tìm số lớn gần nhất và số nhỏ gần nhất

[Hoàng Trọng Nghĩa]

Nếu như công thức trong Excel ta tính được số lớn gần nhất:

{=MIN(IF(C3:F3>G3,C3:F3))}

và số nhỏ gần nhất:

{=MAX(IF(C3:F3<G3,C3:F3))}

Thì hàm tự tạo mà tôi sẽ trình bày dưới đây cũng có thể tính được như công thức trên:
tính số lớn gần nhất:

=FindClosestNumber(C3:F3,G3)

và số nhỏ gần nhất:

=FindClosestNumber(C3:F3,G3,1)

Và đây là hàm FindClosestNumber:

Function FindClosestNumber(ByVal rngData As Range, dblNumber As Double, Optional ByVal bytNum As Byte) As Double
    Dim arrNum()
    Dim n As Long
    Dim rng As Range
    If bytNum = 0 Then
        For Each rng In rngData
            If Val(rng.Value) > dblNumber Then
                n = n + 1
                ReDim Preserve arrNum(1 To n)
                arrNum(n) = Val(rng.Value)
            End If
        Next
        If n Then FindClosestNumber = WorksheetFunction.Min(arrNum)
    Else
        For Each rng In rngData
            If Val(rng.Value) < dblNumber Then
                n = n + 1
                ReDim Preserve arrNum(1 To n)
                arrNum(n) = Val(rng.Value)
            End If
        Next
        If n Then FindClosestNumber = WorksheetFunction.Max(arrNum)
    End If
End Function

Ai có nhu cầu thì sử dụng, không có thì thôi, và nếu ai có hàm nào hay hơn, ngắn gọn hơn thì chia sẻ.

P/s: Giải thích các tham số trong hàm:

Function FindClosestNumber(ByVal rngData As Range, dblNumber As Double, Optional ByVal bytNum As Byte) As Double

1) rngData: Vùng dữ liệu cần so sánh
2) dblNumber: Giá trị dạng số cần so sánh
3) bytNum: Nếu bằng 0 thì hàm trả về giá trị gần nhất lớn hơn giá trị cần so sánh và nếu khác 0 thì hàm trả về giá trị gần nhất nhỏ hơn giá trị cần so sánh. Mặc định là 0 nên không cần ghi ra tham số nếu tìm giá trị lớn gần nhất.

Như vậy FindClosestNumber tìm 2 kiểu giá trị lớn hơn hoặc nhỏ hơn gần nhất so với giá trị cần so sánh tùy thuộc vào bytNum.

 

[Hoàng Trọng Nghĩa]

Vầy chắc gọn hơn

Function FindClosestNumber(ByVal rng As Range, ByVal num As Double, Optional ByVal n As Byte = 1)
Dim cell As Range, res
res = Array("No result", "No result")
For Each cell In rng
    If cell.Value < num Then
        If (cell.Value > res(0)) Or res(0) = "No result" Then res(0) = cell.Value
    End If
    If cell.Value > num Then
        If (cell.Value < res(1)) Or res(1) = "No result" Then res(1) = cell.Value
    End If
Next
FindClosestNumber = res(n - 1)
End Function

Cám ơn bạn, hàm ngắn gọn cám ơn bạn.

 

[VetMini]

Vầy chắc gọn hơn

Function FindClosestNumber(ByVal rng As Range, ByVal num As Double, Optional ByVal n As Byte = 1)
Dim cell As Range, res
res = Array("No result", "No result")
For Each cell In rng
    If cell.Value < num Then
        If (cell.Value > res(0)) Or res(0) = "No result" Then res(0) = cell.Value
    End If
    If cell.Value > num Then
        If (cell.Value < res(1)) Or res(1) = "No result" Then res(1) = cell.Value
    End If
Next
FindClosestNumber = res(n - 1)
End Function

Nếu giải thuật tìm bao gồm cả hai trị thì người ta viết một hàm trả về cả hai trị và một hàm để chọn một trong hai.
Lợi điểm: khi cần tìm cả hai thì chỉ cần tính 1 lần.

Function FindClosestVal(ByVal rng As Range, ByVal num As Double, Optional ByVal n As Byte = 1)
' hàm duyệt các số trong range rng và trả về giá trị gần nhất với num
' tham số n (trị 0/1) xác định trị ấy nhỏ hơn n (0), hay lớn hơn n (1)
FindClosestVal = FindClosestVals(rng, num)(n - 1)
End Function

Function FindClosestVals(ByVal rng As Range, ByVal num As Double)
' hàm duyệt các số trong range rng và trả về một mảng hai phần tử
' phần tử thứ nhất (0) là số gần nhất với num và nhỏ hơn num (max của các số nhỏ hơn num)
' phần tử thứ hai (1) là số gần nhất với num và lớn hơn num (min của các số lớn hơn num)
Dim cell As Range, res
res = Array("No result", "No result")
For Each cell In rng
If cell.Value < num Then
If (cell.Value > res(0)) Or res(0) = "No result" Then res(0) = cell.Value
ElseIf cell.Value > num Then
If (cell.Value < res(1)) Or res(1) = "No result" Then res(1) = cell.Value
End If
Next
FindClosestVals = res
End Function

 

[ptm0412]

Thử thực hiện tương đối đầy đủ các bước test nên trong bài #32, viết lại như sau (vẫn chưa chắc là hết mọi trường hợp)
- Giá trị dò là variant
- tùy chọn tìm là boolean: false hoặc 0 là tìm lớn hơn gần nhất, true hoặc số khác 0 là tìm nhỏ hơn gần nhất
- kết quả hàm là variant
- tùy chọn tìm mặc định false và có thể bỏ trống
- giá trị lỗi, giá trị text, ô trống trong vùng dò tìm bị bỏ qua.

Function ClosestNum(ByVal SearchData As Range, Num, Optional ByVal CloseType As Boolean)
    Dim rng As Range, tmp, Cll As Range
    '' Error of Num
    If Not IsNumeric(Num) Then ClosestNum = "Not number": Exit Function
    ''----------
    If CloseType = 0 Then ''Close type = false
        For Each Cll In SearchData
            If Not IsError(Cll.Value) And Not IsEmpty(Cll) And IsNumeric(Cll) Then  '' Ignore data error and blank cell
                If Cll.Value >= Num Then
                    If IsEmpty(tmp) Then '' tmp is null/ empty
                         tmp = Cll.Value
                    ElseIf Not IsEmpty(tmp) And Cll.Value <= tmp Then
                          tmp = Cll.Value
                    End If
                End If
            End If
        Debug.Print Cll.Address, Cll.Value, tmp
        Next
    Else '' close type =true
        For Each Cll In SearchData
            If Not IsError(Cll.Value) And Not IsEmpty(Cll) And IsNumeric(Cll) Then '' Ignore data error and blank cell
                If Cll.Value <= Num Then
                    If IsEmpty(tmp) Then '' tmp is null/ empty
                         tmp = Cll.Value
                    ElseIf Not IsEmpty(tmp) And Cll.Value >= tmp Then
                          tmp = Cll.Value
                    End If
                End If
            End If
        Next
    End If
ClosestNum = IIf(Not IsEmpty(tmp), tmp, "NA")
End Function

Bảng test:

 

[ptm0412]

Test đầy đủ hơn nữa:
Giá trị dò tìm:
- Giá trị dò tìm rỗng
- giá trị tìm là text
- Giá trị tìm là giá trị lỗi
- giá trị dò tìm tham chiếu 2 ô
- giá trị dò tìm tham chiếu ô rỗng
- Giá trị tìm là ngày tháng
Vùng dò tìm:
- vùng dò tìm toàn lỗi
- vùng dò tìm chỉ 1 ô
- vùng dò tìm chỉ 1 ô và là ô lỗi
- vùng dò tìm 1 ô rỗng
- Vùng dò tìm là ngày tháng






Code:

Một bài đố nhỏ cho ai rảnh và quan tâm

Chỉ sợ ngày mai ai cũng đua ra đường do nới lỏng giãn cách HCM

 

[VetMini]

Thuật toán so sánh:

Nếu tôi viết hàm FindClosestVals như bài #42 thì tôi dùng thuật toán so sánh như sau:
Lý thuyết hội tụ nhị phân: nếu một số nằm giữa hai số x1 và x2 gần y nhất thì số ấy có thể thay thế x1 hoặc x2

Function FindClosestVals(ByVal rng As Range, ByVal num As Double)
' hàm duyệt các số trong range rng và trả về một mảng hai phần tử
' phần tử thứ nhất (0) là số gần nhất với num và nhỏ hơn num (max của các số nhỏ hơn num)
' phần tử thứ hai (1) là số gần nhất với num và lớn hơn num (min của các số lớn hơn num)
Const SORATTO = 9E100#
Dim cell As Range, x0 As Double, x1 As Double
x0 = -SORATTO
x1 = SORATTO
For Each cell In rng
If cell.Value > x0 And cell.Value < x1 Then
If cell.Value < num Then
x0 = cell.Value
ElseIf cell.Value > num Then
x1 = cell.Value
End If
End If
Next
FindClosestVals = Array( IIF(x0 > -SORATTO, x0, "No Results"), IIF(x1 < SORATTO, x1, "No Results") )
End Function

 

[ptm0412]

Test đầy đủ hơn nữa:
Code: Một bài đố nhỏ cho ai rảnh và quan tâm

Câu đố ế. Chắc tại dễ quá nên bị chê, kể cả @phihndhsp cũng không thèm làm.

 

[concogia]

Câu đố ế. Chắc tại dễ quá nên bị chê, kể cả @phihndhsp cũng không thèm làm.

Cho bài đàng hoàng mới làm chứ, có hình không sao mà làm, mà bài này đi xa quá với bài 1 của chú Nghĩa đẹp "chai" rồi Thầy
Hihi

 

[phihndhsp]

Câu đố ế. Chắc tại dễ quá nên bị chê, kể cả @phihndhsp cũng không thèm làm.

dạ do dạo này em bị dí quá nên không tham gia được hihi, với những dạng tìm kiếm số gần nhất thì em cũng dùng tìm kiếm nhị phân để làm, dữ liệu sort trước, nếu mảng 2 chiều hay nhiều chiều thì cũng chuyển về mảng 1 chiều và sắp xếp, sau đó dùng tìm kiếm nhị phân đề xét thằng nào gần nhất theo chặn trên hay chặn dưới. còn những dạng bài toán nhiều dữ liệu thì em chưa có làm, dạ chắc rảnh rảnh em sẽ làm và học hỏi thầy ạ hihi.

 

[ptm0412]

Cho bài đàng hoàng mới làm chứ, có hình không sao mà làm, mà bài này đi xa quá với bài 1 của chú Nghĩa đẹp "chai" rồi Thầy
Hihi

Y chang á anh. Chỉ là test lại từng lỗi ra kết quả của từng lần test, chứ code bài 1 lỗi.
Ngoài ra số và ngày có bà con nên áp dụng tìm ngày gần nhất (trái/ phải) luôn. Làm xong có khi tự gọi là siêu hàm với người ta.