Nhờ giúp đỡ code lọc dữ liệu có giá trị lớn nhất (1 người xem)

[cartoon18]

-mình có ý định tạo một code lọc bỏ toàn bộ dữ liệu trùng sau đó tìm giá trị lơn nhất của dữ liệu sau khi đã lọc,
- 1 về phần lọc thì có thể làm được bằng remove duplicates hoặc CreateObject("Scripting.Dictionary") (cái này học của thầy NDU )
- 2 phần tìm giá trị lớn nhất thì mình làm mãi mà không được mong mọi người giúp đỡ với ah.
mình có gửi file đính kèm: khi mở form lên thì chọn cột E - bấm copy - chon cell bất kỳ - paste (code mình làm cho giá trị không đúng )

 

[khuongvietphong]

-mình có ý định tạo một code lọc bỏ toàn bộ dữ liệu trùng sau đó tìm giá trị lơn nhất của dữ liệu sau khi đã lọc,
- 1 về phần lọc thì có thể làm được bằng remove duplicates hoặc CreateObject("Scripting.Dictionary") (cái này học của thầy NDU )
- 2 phần tìm giá trị lớn nhất thì mình làm mãi mà không được mong mọi người giúp đỡ với ah.
mình có gửi file đính kèm: khi mở form lên thì chọn cột E - bấm copy - chon cell bất kỳ - paste (code mình làm cho giá trị không đúng )

Mình không biết viết code cho bài toán này, dùng CT được không bạn

 

[phulien1902]

-mình có ý định tạo một code lọc bỏ toàn bộ dữ liệu trùng sau đó tìm giá trị lơn nhất của dữ liệu sau khi đã lọc,
- 1 về phần lọc thì có thể làm được bằng remove duplicates hoặc CreateObject("Scripting.Dictionary") (cái này học của thầy NDU )
- 2 phần tìm giá trị lớn nhất thì mình làm mãi mà không được mong mọi người giúp đỡ với ah.
mình có gửi file đính kèm: khi mở form lên thì chọn cột E - bấm copy - chon cell bất kỳ - paste (code mình làm cho giá trị không đúng )

Bạn dùng công cụ Consolidate chỉ mất vài giây, bạn làm như sau:
1. Đặt trỏ chuột tại 1 Cell bất kỳ( ví dụ L5)
2. Vào Data \ Consolidate
Funtion: Max
Quét chọn vùng $E$5:$F$33, rồi tích vào Left Column, OK.
Xong.

 

[Let'GâuGâu]

-mình có ý định tạo một code lọc bỏ toàn bộ dữ liệu trùng sau đó tìm giá trị lơn nhất của dữ liệu sau khi đã lọc,
- 1 về phần lọc thì có thể làm được bằng remove duplicates hoặc CreateObject("Scripting.Dictionary") (cái này học của thầy NDU )
- 2 phần tìm giá trị lớn nhất thì mình làm mãi mà không được mong mọi người giúp đỡ với ah.
mình có gửi file đính kèm: khi mở form lên thì chọn cột E - bấm copy - chon cell bất kỳ - paste (code mình làm cho giá trị không đúng )

Sub BonjourVietNam()
Dim data, kq(1 To 60000, 1 To 2) As Variant, i, j, k As Long, dic As Object
data = [e5:f33]
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(data)
    If Not dic.exists(data(i, 1)) Then
        k = k + 1
        dic.Add data(i, 1), k
        kq(i, 1) = data(i, 1)
        kq(i, 2) = data(i, 2)
    Else
        j = dic.Item(data(i, 1))
        If data(i, 2) > kq(j, 2) Then kq(j, 2) = data(i, 2)
    End If
Next

If k Then
[i2:j2].Clear
[i2].Resize(k, 2) = kq
End If

End Sub

 

[phulien1902]

To: Bác Let'GâuGâu.
Khi chạy Code của bác em thấy giá trị k chưa xuất hiện tại Cell I7 thì phải?
[h=2][/h]

 

[Vo Tinh]

-mình có ý định tạo một code lọc bỏ toàn bộ dữ liệu trùng sau đó tìm giá trị lơn nhất của dữ liệu sau khi đã lọc,
- 1 về phần lọc thì có thể làm được bằng remove duplicates hoặc CreateObject("Scripting.Dictionary") (cái này học của thầy NDU )
- 2 phần tìm giá trị lớn nhất thì mình làm mãi mà không được mong mọi người giúp đỡ với ah.
mình có gửi file đính kèm: khi mở form lên thì chọn cột E - bấm copy - chon cell bất kỳ - paste (code mình làm cho giá trị không đúng )

Sửa 2 sub trong file của bạn lại

Sub CopyAMax()
Dim Arr(), i As Long
On Error Resume Next
Text1 = Copy_paste.TCP.Text
Arr = Range(Text1)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr, 1)
    If Arr(i, 1) <> "" Then
        If Not Dic.Exists(Arr(i, 1)) Then
            Dic.Add Arr(i, 1), Arr(i, 2)
        Else
            If Arr(i, 2) > Dic.Item(Arr(i, 1)) Then Dic.Item(Arr(i, 1)) = Arr(i, 2)
        End If
    End If
Next i
End Sub


Sub pasteAMax()
Selection.Resize(Dic.Count) = Application.Transpose(Dic.keys)
Selection.Resize(Dic.Count).Offset(, 1) = Application.Transpose(Dic.items)
Copy_paste.Hide
End Sub

 

[doveandrose]

To: Bác Let'GâuGâu.
Khi chạy Code của bác em thấy giá trị k chưa xuất hiện tại Cell I7 thì phải?

hay quá bạn ơi hi hi

Sub BonjourVietNam()
Dim data, kq(1 To 60000, 1 To 2) As Variant, i, j, k As Long, dic As Object
data = [e5:f33]
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(data)
    If Not dic.exists(data(i, 1)) Then
        k = k + 1
        dic.Add data(i, 1), k
        kq([COLOR=#ff0000][SIZE=5][B]i[/B][/SIZE][/COLOR], 1) = data(i, 1)
        kq([COLOR=#ff0000][SIZE=5][B]i[/B][/SIZE][/COLOR], 2) = data(i, 2)
    Else
        j = dic.Item(data(i, 1))
        If data(i, 2) > kq(j, 2) Then kq(j, 2) = data(i, 2)
    End If
Next

If k Then
[i2:j2].Clear
[i2].Resize(k, 2) = kq
End If

End Sub

 

[Hoàng Trọng Nghĩa]

To: Bác Let'GâuGâu.
Khi chạy Code của bác em thấy giá trị k chưa xuất hiện tại Cell I7 thì phải?

Thử với nó xem sao:

Sub LocDuyNhatMax()
    Dim c As Byte
    Dim Dict As Object
    Dim arrNguon, arrKetQua(1 To 65536, 1 To 2)
    Dim n As Long, r As Long, endRow As Long, dMax As Double
    Dim strItem As String
    endRow = Sheet1.Range("E" & Rows.Count).End(xlUp).Row
    arrNguon = Sheet1.Range("E5:F" & endRow)
    Set Dict = CreateObject("Scripting.Dictionary")
    For r = 1 To UBound(arrNguon)
        strItem = arrNguon(r, 1)
        dMax = arrNguon(r, 2)
        If Dict.Exists(strItem) Then
            If arrKetQua(Dict.Item(strItem), 2) < dMax Then
                arrKetQua(Dict.Item(strItem), 2) = dMax
            End If
        Else
            n = n + 1
            Dict.Add strItem, n
            arrKetQua(n, 1) = strItem
            arrKetQua(n, 2) = dMax
        End If
    Next
    Sheet1.Range("I:J").ClearContents
    Sheet1.Range("I2:J2").Resize(n).Value = arrKetQua
End Sub

 

[cartoon18]

cám ơn mọi người đã chỉ giáo mình đã hoàn thiện được code, nhưng cho mình hỏi thêm chút xíu nữa đó là nếu mình không muốn chọn giá trị lớn nhất mà lấy giá trị lớn thứ 2 hoặc thứ 3 thì sao nhỉ (giống như hàm Lagre vậy đó)

 

[Hoàng Trọng Nghĩa]

cám ơn mọi người đã chỉ giáo mình đã hoàn thiện được code, nhưng cho mình hỏi thêm chút xíu nữa đó là nếu mình không muốn chọn giá trị lớn nhất mà lấy giá trị lớn thứ 2 hoặc thứ 3 thì sao nhỉ (giống như hàm Lagre vậy đó)

Thí dụ nó chỉ có 1 giá trị, thì sao biết được nó thứ 2 hay thứ 3 bạn?

Nếu nói hàm Large gì đó, vậy thôi ta chỉ cần lọc duy nhất 1 cột, cột còn lại làm cha nó cái hàm Large cho rồi.

 

[cartoon18]

Thí dụ nó chỉ có 1 giá trị, thì sao biết được nó thứ 2 hay thứ 3 bạn?

Nếu nói hàm Large gì đó, vậy thôi ta chỉ cần lọc duy nhất 1 cột, cột còn lại làm cha nó cái hàm Large cho rồi.

Đúng là làm như vậy thì xử lý ngon lành (mặc dù chạy hơi chậm nếu chọn cả column) cảm ơn bác đã góp ý


Function Large2(Vung As Variant, thamchieu As String, Num As Byte) As String
Dim Arr(), Aps(), i As Double, j As Integer, Text As String
Text = Vung.Address
Arr = Range(Text)
j = 0
ReDim Aps(Application.CountIf(Range(Text), thamchieu), 1)
For i = 1 To UBound(Arr)
If UCase(Arr(i, 1)) Like UCase(thamchieu) Then
j = j + 1
Aps(j, 1) = Arr(i, 2)
End If
Next i
Large2 = Application.Large(Aps, Num)
End Function