lọc giá trị max (1 người xem)

[authority]

em chào các anh ạ
các anh giúp em bảng tính này với ạ
em có bảng tính như thế này
giúp em thế này ạ


ở cột point có 2 hoặc 3 giá trị nhưng sau khi lọc thì chỉ còn 1 point
Ví dụ
point 1 có 2 giá trị FX,FY,FZ,MX,MY
sau khi lọc thì cột 1 chỉ còn 1 giá trị và giá trị đó là MAX của 2 giá trị trước
FX=max của những giá trị đã có
FY,FZ,MX,MY cũng còn lại giá trị max ạ
em cảm ơn các anh

 

[ndu96081631]

em chào các anh ạ
các anh giúp em bảng tính này với ạ
em có bảng tính như thế này
giúp em thế này ạ


ở cột point có 2 hoặc 3 giá trị nhưng sau khi lọc thì chỉ còn 1 point
Ví dụ
point 1 có 2 giá trị FX,FY,FZ,MX,MY
sau khi lọc thì cột 1 chỉ còn 1 giá trị và giá trị đó là MAX của 2 giá trị trước
FX=max của những giá trị đã có
FY,FZ,MX,MY cũng còn lại giá trị max ạ
em cảm ơn các anh

Bài này không gì sướng bằng dùng PivotTable, bạn đã thử chưa?

 

[kyo]

Dùng PivotTable thì quá là sướng rồi, hic, kyo cũng không nghĩ ra (lần nào đụng bài cũng chỉ code với code)
Lỡ viết rồi, nhân đây kyo cũng muốn góp một đoạn code:

[GPECODE=vb]Sub test()
Dim r As Long, i As Long, j As Long, k As Long
Dim arr1, dic, arr2


r = Range("A65000").End(xlUp).Row
j = 0

arr1 = Range("a2:F" & r).Value
Range("i2:N" & r).Value = ""
ReDim arr2(1 To UBound(arr1, 1), 1 To UBound(arr1, 2))

Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr1, 1)
If Not IsEmpty(arr1(i, 1)) And Not dic.exists(arr1(i, 1)) Then
dic.Add arr1(i, 1), ""
j = j + 1
For k = 1 To 6
arr2(j, k) = arr1(i, k)
Next k
Else
For k = 2 To 6
If arr1(i, k) > arr2(j, k) Then arr2(j, k) = arr1(i, k)
Next k
End If
Next i
Range("i2").Resize(UBound(arr2, 1), 6).Value = arr2
End Sub[/GPECODE]

 

[Hai Lúa Miền Tây]

Nếu dùng code thì mình dùng thử = ADO xem sao nhé:

[GPECODE=sql]Sub Max_HLMT()
Dim lsSQL As String, cnn As Object, lrs As Object
Set cnn = CreateObject("ADODB.Connection")
Set lrs = CreateObject("ADODB.Recordset")
With cnn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;"";"
.Open
End With
lsSQL = "SELECT F1, Max(F2), Max(F3), Max(F4), Max(F5), Max(F6) " & _
"FROM [Sheet1$A2:F3500] " & _
"GROUP BY F1 " & _
"HAVING F1<>0"
lrs.Open lsSQL, cnn, 3, 1
With Sheet1
.[K22000].ClearContents
.[K2].CopyFromRecordset lrs
End With
lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing

End Sub
[/GPECODE]

 

[authority]

Dùng PivotTable thì quá là sướng rồi, hic, kyo cũng không nghĩ ra (lần nào đụng bài cũng chỉ code với code)
Lỡ viết rồi, nhân đây kyo cũng muốn góp một đoạn code:

[GPECODE=vb]Sub test()
Dim r As Long, i As Long, j As Long, k As Long
Dim arr1, dic, arr2


r = Range("A65000").End(xlUp).Row
j = 0

arr1 = Range("a2:F" & r).Value
Range("i2:N" & r).Value = ""
ReDim arr2(1 To UBound(arr1, 1), 1 To UBound(arr1, 2))

Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr1, 1)
If Not IsEmpty(arr1(i, 1)) And Not dic.exists(arr1(i, 1)) Then
dic.Add arr1(i, 1), ""
j = j + 1
For k = 1 To 6
arr2(j, k) = arr1(i, k)
Next k
Else
For k = 2 To 6
If arr1(i, k) > arr2(j, k) Then arr2(j, k) = arr1(i, k)
Next k
End If
Next i
Range("i2").Resize(UBound(arr2, 1), 6).Value = arr2
End Sub[/GPECODE]

cái này sau mỗi giá trị lọc đều là 0 anh ạ
em cảm ơn anh đã giúp ạ

 

[Hai Lúa Miền Tây]

cái này sau mỗi giá trị lọc đều là 0 anh ạ
em cảm ơn anh đã giúp ạ

Nếu dùng code thấy khó và rắc rối, bạn nên dùng Pivot theo như bài #2 mà Thầy Tuấn đã hướng dẫn đó.

 

[kyo]

cái này sau mỗi giá trị lọc đều là 0 anh ạ
em cảm ơn anh đã giúp ạ

Sau mỗi giá trị lọc đều là 0 là sao bạn? kyo đã test trên dữ liệu của bạn rồi, không hề có vấn đề gì. Có chăng thì nguyên một dãy phía cuối của bạn toàn giá trị 0 hết nên dòng cuối của dữ liệu mới có dòng số 0.

 

[Quang_Hải]

Rảnh quá nên luyện code tí. Viết xong thì lại thấy giống y chang code bài 3.
Phương án này giống bài 3 của Kyo, nhưng nếu dữ liệu của cột A không được sort thì code bài 3 có thể ra đáp án không chính xác

Sub lay_max()
Dim kq(1 To 65536, 1 To 6), dl(), i As Long, j As Byte, k As Long
dl = Range([A2], [a65536].End(3)).Resize(, 6).Value
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(dl)
      If dl(i, 1) <> "" Then
         If Not .exists(dl(i, 1)) Then
            k = k + 1
            .Add dl(i, 1), k
            For j = 1 To 6
               kq(k, j) = dl(i, j)
            Next
         Else
            For j = 2 To 6
               If kq(.Item(dl(i, 1)), j) < dl(i, j) Then
                  kq(.Item(dl(i, 1)), j) = dl(i, j)
               End If
            Next
         End If
      End If
   Next
End With
[I2].Resize(k, 6) = kq
End Sub

 

[authority]

Sau mỗi giá trị lọc đều là 0 là sao bạn? kyo đã test trên dữ liệu của bạn rồi, không hề có vấn đề gì. Có chăng thì nguyên một dãy phía cuối của bạn toàn giá trị 0 hết nên dòng cuối của dữ liệu mới có dòng số 0.

em cảm ơn anh ạ
vì sau point 96 luôn có giá trị số 0 đó ạ
mà em đã cho ẩn số 0 nên ok rồi ạ