Từ địa chỉ cells, bằng ParamArray trả về địa chỉ vùng Range lớn nhất

  • Thread starter thuthuy2000
  • Ngày gửi
T

thuthuy2000

Guest
Xin các Thầy và các anh chị đi trước dành chút thời gian gợi ý giùm em với ạ:
Em muốn xây dựng hàm như sau:
  • Dùng ParamArray nhận điạ chỉ cells.
  • Trả về Range Object Có kích thước lớn nhất chứa các cells đã nêu ở trên.
Ví dụ :
("A1","C3","B5") kết quả là Range("A1:C5")
Bạn cần đăng nhập để thấy hình ảnh

("B2","C7","F3","D5") kết quả là Range("B2:F7")
Bạn cần đăng nhập để thấy hình ảnh

Kính mong các thầy và anh chị chia sẻ giúp ạ! Em cảm ơn!
 
Sửa lần cuối bởi điều hành viên:

NhanSu

SMod
Thành viên BQT
Một range có dạng như đề bài sẽ bao gồm các vùng (area). Mỗi area đó là hình chữ nhật bao gồm các cell. Ta xác định địa chỉ cell ở góc trên, trái là RowTT ColTT; địa chỉ của cell dưới phải là RowDP ColDP. Hình chữ nhật bao tất cả các area sẽ có địa chỉ ô trên, trái RowTT và ColTT là min của tất cả các RowTT và min ColTT; địa chỉ ô dưới, phải RowDP và ColDP là max của tất cả RowDP và ColDP.
 
B

bvtvba

Guest
Bạn thử:
Mã:
Sub test()
    Dim r As Range
    Set r = LayRangeLonNhat("B2", "C7", "F3", "D5")
    Debug.Print r.Address(False, False)
End Sub
Private Function LayRangeLonNhat(ParamArray parrDiaChi()) As Range
    Dim adr As Variant
    Dim CotLonNhat As Long: CotLonNhat = 0
    Dim CotNhoNhat As Long: CotNhoNhat = Rows.Count
    Dim DongLonNhat As Long: DongLonNhat = 0
    Dim DongNhoNhat As Long: DongNhoNhat = Columns.Count
  
    For Each adr In parrDiaChi
        CotLonNhat = IIf(Range(adr).Column > CotLonNhat, Range(adr).Column, CotLonNhat)
        CotNhoNhat = IIf(Range(adr).Column < CotNhoNhat, Range(adr).Column, CotNhoNhat)
        DongLonNhat = IIf(Range(adr).Row > DongLonNhat, Range(adr).Row, DongLonNhat)
        DongNhoNhat = IIf(Range(adr).Row < DongNhoNhat, Range(adr).Row, DongNhoNhat)
    Next adr
    Set LayRangeLonNhat = Range(Cells(DongNhoNhat, CotNhoNhat), Cells(DongLonNhat, CotLonNhat))
End Function
Kết quả:
Bạn cần đăng nhập để thấy đính kèm
 
T

thuthuy2000

Guest
Em cảm ơn @bvtvba , em chạy thử chưa thấy đúng lắm.
Mã:
"B2:C7","B2:F3","B2:D5","C3:F7" Kết quả mong muốn là B2 : F7
Bạn cần đăng nhập để thấy hình ảnh

Bạn cần đăng nhập để thấy hình ảnh
 
Mình sửa lại code của @bvtvba .Bạn thử:
Mã:
Sub test()
    Dim r As Range
    Set r = LayRangeLonNhat("B2:C7", "B2:F3", "B2:D5", "C3:F7", "")
    Debug.Print r.Address(False, False)
End Sub
Private Function LayRangeLonNhat(ParamArray parrDiaChi()) As Range
    Dim adr As Variant, r1  As Range
   
    Dim CotLonNhat As Long: CotLonNhat = 0
    Dim CotNhoNhat As Long: CotNhoNhat = Rows.Count
    Dim DongLonNhat As Long: DongLonNhat = 0
    Dim DongNhoNhat As Long: DongNhoNhat = Columns.Count
   
    On Error GoTo tiep
   
    For Each adr In parrDiaChi
       
            For Each r1 In Range(adr)

                CotLonNhat = IIf(r1.Column > CotLonNhat, r1.Column, CotLonNhat)
                CotNhoNhat = IIf(r1.Column < CotNhoNhat, r1.Column, CotNhoNhat)
                DongLonNhat = IIf(r1.Row > DongLonNhat, r1.Row, DongLonNhat)
                DongNhoNhat = IIf(r1.Row < DongNhoNhat, r1.Row, DongNhoNhat)
tiep:
    If r1 Is Nothing Then GoTo tiep2
            Next r1
       
tiep2:
   
    Next adr
    Set LayRangeLonNhat = Range(Cells(DongNhoNhat, CotNhoNhat), Cells(DongLonNhat, CotLonNhat))
End Function
Kết quả:
Bạn cần đăng nhập để thấy hình ảnh
 

NhanSu

SMod
Thành viên BQT
Mình làm theo hướng khác, không giống đề bài lắm, lập hàm nhận tham số đầu vào là range bao gồm nhiều vùng. Trên sheet có thể giữ Ctrl rồi kéo chuột để tạo ra các vùng này.
Bạn cần đăng nhập để thấy hình ảnh

Mã:
Option Explicit

Function Bound(r As Range) As Range
    Dim A As Range
    Dim rMax&, cMax&, rMin&, cMin&, rA&, cA&
    cMin = 2000000
    rMin = 2000000
   
    For Each A In r.Areas
        rA = A.Cells(1, 1).Row
        cA = A.Cells(1, 1).Column
        If rA < rMin Then rMin = rA
        If cA < cMin Then cMin = cA
        rA = rA + A.Rows.Count - 1
        cA = cA + A.Columns.Count - 1
        If rA > rMax Then rMax = rA
        If cA > cMax Then cMax = cA
    Next
    Set Bound = Range(Cells(rMin, cMin), Cells(rMax, cMax))
   
End Function
Sub Test()
    Debug.Print Bound(Selection).Address
    Debug.Print Bound(Range("A1, B2:C2, D5:G6, A1:B2")).Address
End Sub
Kết quả:
Bạn cần đăng nhập để thấy hình ảnh


Ghi chú: trong cách làm của mình đang để tham số đầu vào là range, bạn có thể sử dụng hàm này là hàm phụ để xử lý trong trường hợp ParamArray.
 
Sửa lần cuối:
T

thuthuy2000

Guest
Em cảm ơn các thầy.
Em đã thử và thành công rồi.
 
Top