Tìm những giá trị cao nhất trùng nhau

[hoarong]

Tôi có vấn đề này làm chưa được , xin các anh chị giúp giùm
Tìm những giá trị max trùng nhau cho vào cùng 1 ô kết quả
Cảm ơn rất nhiều

 

[hoangminhtien]

bạn xem file có giúp được gì cho bạn không?

 

[SA_DQ]

Bạn tham khảo cái ni, nha!

Option Explicit

Sub AllMAX()
 Dim Rng As Range, Clls As Range, Hg As Integer
 Dim Value_ As Double, Ten As String
 
 Set Rng = Application.InputBox("Hay Chon Vung Can Thiet:", "Dung Chuot", Type:=8)
 If Rng Is Nothing Then Exit Sub:            Range("B1:C2").Clear
 Hg = InputBox("Nhap Cu Li:", , "2")
 For Each Clls In Rng
   With Clls
      If .Value > Value_ Then
         Value_ = .Value:              Ten = .Offset(Hg)
      ElseIf .Value = Value_ Then
         Ten = Ten & ", " & .Offset(Hg)
      End If
   End With
 Next Clls
 [b1] = "Max":             [C1] = "Tên"
 [B2] = Value_:            [c2] = Ten
 
End Sub

 

[anhtuan1066]

Gữi bạn 2 cách... Theo ý kiến của tôi thì nên dùng cách 2, vì ta ko thể xác định chính xác có bao nhiêu phần tử trùng, ghép tên lại như vậy ko phải là cách hay bằng việc tách tên ra riêng thành từng ô

 

[hoarong]

Thành thật cám ơn các anh
Nhưng quả thật làm như vậy thì không ổn lắm , Vì Danh sách của tôi có 30 loại , và 20 cột
Tương ứng là kích thước là 30x20 , mỗi dòng , tôi phải tìm max từng dòng , kèm theo Tên các loại max đó , làm theo các cách trên hình như ko ổn lắm
Các anh em coi lại giùm , vả lại , danh sách của tôi có 1 rừng dày đặc , quả thật là khó có thể thêm dòng hay cột vào , nếu được chỉ cho vào được vài dòng rồi hide thôi , tôi ko biết phải làm sau nếu như cách của các anh thì thêm dòng thêm cột cho mỗi dòng max đó thì ko được
File mầu thế này :

 

[Mr Okebab]

Thành thật cám ơn các anh
Nhưng quả thật làm như vậy thì không ổn lắm , Vì Danh sách của tôi có 30 loại , và 20 cột
Tương ứng là kích thước là 30x20 , mỗi dòng , tôi phải tìm max từng dòng , kèm theo Tên các loại max đó , làm theo các cách trên hình như ko ổn lắm
Các anh em coi lại giùm , vả lại , danh sách của tôi có 1 rừng dày đặc , quả thật là khó có thể thêm dòng hay cột vào , nếu được chỉ cho vào được vài dòng rồi hide thôi , tôi ko biết phải làm sau nếu như cách của các anh thì thêm dòng thêm cột cho mỗi dòng max đó thì ko được
File mầu thế này :

bạn thử nhé :

Function TenMax(MangGT As Range, MangTen As Range) As String
    Application.Volatile (False)
    If MangGT.Columns.Count <> MangTen.Columns.Count Then Exit Function
    If MangGT.Rows.Count <> MangTen.Rows.Count Then Exit Function
    If MangGT.Rows.Count > 1 Then Exit Function
    Dim i As Long, Temp As Double
    Temp = WorksheetFunction.Max(MangGT)
    For i = 1 To MangGT.Columns.Count
        If MangGT(i) = Temp Then TenMax = TenMax & "," & MangTen(i)
    Next
    TenMax = Mid$(TenMax, 2, 100)
End Function

Thân!

 

[ndu96081631]

Tôi cũng có 1 code (chưa hay bằng của Mr Okebab)

Option Explicit

Function TenMax(VungGT As Range, Sosanh As Double, VungTen As Range) As String
 Dim Clls As Range
 Dim Temp As String
 For Each Clls In VungGT
      If Clls.Value = Sosanh Then
         Temp = Temp & ", " & Cells(VungTen.Row, Clls.Column).Value
      End If
 Next Clls
 TenMax = Right(Temp, Len(Temp) - 1)
End Function

Thêm 1 tham số Sosanh nữa để tùy biến hơn (có thể chọn các giá trị khác không phải là MAX)

 

[hoangminhtien]

nếu dữ liệu của bạn chỉ có 30X20 thì có thể làm theo file đính kèm

 

[ndu96081631]

nếu dữ liệu của bạn chỉ có 30X20 thì có thể làm theo file đính kèm

Cách làm này và cách dùng VBA thực chất là 1 (cũng là tìm và nối chuổi). Tuy nhiên với bài toán trên nhưng với ử liệu lớn thì dùng công thức tỏ ra có nhiều nhược điểm hơn!

 

[hoangminhtien]

vâng, cám ơn bác ndu96081631, vì vậy mà em chỉ nói file này dùng với dữ liệu 30X20 thôi ạ

 

[minhlev]

Function TenMax(MangGT As Range, MangTen As Range) As String
    Application.Volatile (False)
    If MangGT.Columns.Count <> MangTen.Columns.Count Then Exit Function
    If MangGT.Rows.Count <> MangTen.Rows.Count Then Exit Function
    If MangGT.Rows.Count > 1 Then Exit Function
    Dim i As Long, Temp As Double
    Temp = WorksheetFunction.Max(MangGT)
    For i = 1 To MangGT.Columns.Count
        If MangGT(i) = Temp Then TenMax = TenMax & "," & MangTen(i)
    Next
    TenMax = Mid$(TenMax, 2, 100)
End Function

Thân!

Code của bác hay lắm nhưng nên thêm điều kiện là 2 range đó phải thẳng hàng với nhau (VD cùng từ cột B tới cột Z), nếu không sẽ bị lệch kết quả đấy.

Tôi cũng có 1 code (chưa hay bằng của Mr Okebab)

Option Explicit
 
Function TenMax(VungGT As Range, Sosanh As Double, VungTen As Range) As String
 Dim Clls As Range
 Dim Temp As String
 For Each Clls In VungGT
      If Clls.Value = Sosanh Then
         Temp = Temp & ", " & Cells(VungTen.Row, Clls.Column).Value
      End If
 Next Clls
 TenMax = Right(Temp, Len(Temp) - 1)
End Function

Thêm 1 tham số Sosanh nữa để tùy biến hơn (có thể chọn các giá trị khác không phải là MAX)

Code này rất hay.

 

[ndu96081631]

Code này rất hay.

Tôi nghĩ không cần thêm điều kiện 2 range = nhau làm gì, vì khi sử dụng bắt buộc người dùng phải chú ý điều này.
Có vài hàm của MS cũng bắt buộc như vậy thôi (như LOOKUP, SUMPRODUCT...)
Anh minhlev cho tôi hỏi: Tôi đang suy nghĩ giã sử VungGT là 1 cột còn VungTen là 1 dòng thì làm thế nào nhỉ?

 

[Mr Okebab]

Tôi nghĩ không cần thêm điều kiện 2 range = nhau làm gì, vì khi sử dụng bắt buộc người dùng phải chú ý điều này.
Có vài hàm của MS cũng bắt buộc như vậy thôi (như LOOKUP, SUMPRODUCT...)
Anh minhlev cho tôi hỏi: Tôi đang suy nghĩ giã sử VungGT là 1 cột còn VungTen là 1 dòng thì làm thế nào nhỉ?

Nếu họ không chú ý thì sẽ báo lỗi hoặc không thực hiện.

Vì vậy ta phải thực hiện chức năng bẫy lỗi!

Đây là UDF cho bất cứ là hàng hay cột:

Function TenMax(MangGT As Range, MangTen As Range) As String
    Application.Volatile (False)
    'Stop
    If WorksheetFunction.Max(MangGT.Columns.Count, MangGT.Rows.Count) <> _
        WorksheetFunction.Max(MangTen.Columns.Count, MangTen.Rows.Count) _
        Then Exit Function
    If WorksheetFunction.Min(MangGT.Columns.Count, MangGT.Rows.Count) <> _
        WorksheetFunction.Min(MangTen.Columns.Count, MangTen.Rows.Count) _
        Then Exit Function
    If WorksheetFunction.Min(MangGT.Columns.Count, MangGT.Rows.Count) <> 1 _
        Then Exit Function
        
    Dim i As Long, Temp As Double
    Temp = WorksheetFunction.Max(MangGT)
    For i = 1 To WorksheetFunction.Max(MangGT.Columns.Count, MangGT.Rows.Count)
        If MangGT(i) = Temp Then TenMax = TenMax & "," & MangTen(i)
    Next
    TenMax = Mid$(TenMax, 2, 100)
End Function

Thân!