Xếp hạng không trùng

Trạng thái
Không mở trả lời sau này.

Thiên Thanh

Yêu THVBA
Hu hu..... anh mờ không hiểu ý enm hở anh @bvtvba
Xephang(a1,b5,a6:J17, Row(1$:z))
Em cảm ơn anhạ
Hình thức hàm là như vậy đó anh oi.
 

hongphuong

Tôi yêu THVBA
Bạn này trình bày rõ rùi mà
Nếu dùng hàm
=RANK(B2,$B$2:$B$5,1)
Thì chỉ dùng các ô riêng lẻ, nhưng yêy cầu của bạn ý là tìm trong chuỗi cơ
Mà hàm Rank lại xếp hạng trùng nhau nữa
Anh @Euler giúp bạn ấy đi anh oi
 

tuhocvba

Administrator
Thành viên BQT
Thay vì kêu ca người khác chậm hiểu, em nên cảm thấy xấu hổ vì không biết cách trình bày cho người ngu nhất cũng hiểu được. Ai trên diễn đàn hiểu ý tưởng chủ topic thì vô trình bày tôi nghe cái.
 
B

bvtvba

Guest
Trời ạ
Tại sao có những người chậm hiểu như ang vậy?
Excel không llamf được thì người ta mới cần viết hàm chứ.
Cho dù viết ra một cái hàm có giá trị trả về là mảng thì máy tôi cũng không test được. Theo tôi biết office 365 thì ấn ctr shift enter, giá trị mảng sẽ lần lượt được ghi vào các ô liên tiếp.
Excel 2013 của tôi không làm được như vậy. Code thì cũng phải test kết quả. Không test được kết quả nên tôi chịu.
Nếu bạn muốn viết thủ tục thì ok thôi. Rồi bạn tự chuyển thành hàm, bạn có làm được không?
 
Bạn thử :
Mã:
Function sapxep(ParamArray arr() As Variant) As Variant
    Dim r
    Dim r1  As Range
    Dim brr, crr
    Dim s   As String
    Dim Dic As Object
    Dim i   As Long, sl As Long, cnt As Long
    On Error GoTo thoat
    For Each r In arr
        If TypeOf r Is Range Then
            For Each r1 In r
                s = s & "," & r1.Value
            Next r1
            
        End If
        
    Next r
    s = Replace(s, ",,", ",", , , vbTextCompare)
    If s = "" Then GoTo thoat
    
    brr = Split(s, ",")
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = LBound(brr) To UBound(brr) Step 1
        s = CStr(brr(i))
        If s <> "" Then
            If Not Dic.Exists(s) Then
                Dic.Add s, 1
            Else
                Dic.Item(s) = Dic.Item(s) + 1
            End If
        End If
    Next i
    brr = Dic.items
    
    For i = LBound(brr) To UBound(brr) Step 1
        sl = Application.WorksheetFunction.Large(brr, i + 1)
        If Not Dic.Exists("@" & sl & "@") Then
            Dic.Add "@" & sl & "@", 1
            If cnt = 0 Then
                cnt = cnt + 1
                ReDim crr(1 To cnt)
            Else
                cnt = cnt + 1
                ReDim Preserve crr(1 To cnt)
            End If
            crr(cnt) = sl
        End If
    Next i
    ReDim brr(1 To cnt, 1 To 1)
    For i = 1 To cnt Step 1
        brr(i, 1) = crr(i)
    Next i
    sapxep = brr
    Set Dic = Nothing
thoat:

End Function
Bạn cần đăng nhập để thấy hình ảnh


Bạn cần đăng nhập để thấy hình ảnh
 

Thiên Thanh

Yêu THVBA
Em cảm ơn anh @vanthanhVBA rất nhiều ạ
Anh oi anh có thể chuyển thành không phải hàm mảng cho em được không hở anh?
=sapxep(a1,b5,a6:J17, Row(1$:z))
 
Khi mọi người nêu các câu hỏi để làm rõ vấn đề thì bạn thả icon haha.
Mọi người sẽ không đặt câu hỏi nữa, mà cứ lẳng lặng bỏ đi không trả lời nữa.
Với yêu cầu của bạn :
Mã:
=sapxep(a1,b5,a6:J17, Row(1$:z))
Sẽ có mấy câu hỏi:
Mã:
a1,b5,a6:J17
Đây là gì, có phải là vùng dữ liệu không? Bạn nên có hình ảnh mô tả dữ liệu ở những nơi này trông như thế nào.
Mã:
Row(1$:z)
là gì? Có phải là số lượng phần tử mảng mà bạn muốn lấy ra? Bạn cũng nên có hình ảnh mô tả output tương ứng với công thức của bạn nó sẽ như thế nào.
Trên đây là mấy thắc mắc, nếu bạn hợp tác làm rõ thì có thể code tương trợ. Nếu không hợp tác, thì mọi người cũng chỉ còn biết lẳng lặng rời topic mà không tranh cãi gì khỏi mất hòa khí.
 
Trạng thái
Không mở trả lời sau này.
Top