Lọc giá trị Max theo điều kiện? (1 người xem)
- Thread starter 790312
- Ngày gửi
Người dùng đang xem chủ đề này
Ô B4 là Max của X cột C (Ô C4 là Max của Y cột C) trong sheet1 liên quan đến cột A là giá trị T16. Tương tự T15, T14 cũng vậy. Cảm ơn bác.
Lần chỉnh sửa cuối:
Upvote
0
giaiphap
==(^o^)==
- Tham gia
- 12/3/07
- Bài viết
- 5,807
- Được thích
- 6,367
- Donate (Momo)
- Giới tính
- Nam
Sheet2 ô B4 giá trị là 0,002158 mới đúng nghe bạn.
Bạn dùng code này thử xem
Mã:
Sub GPE()
Dim Dic As Object, Tmp As String
Dim i As Long, k As Long
Dim Arr, dArr
Arr = Range(Sheet1.[A4], Sheet1.[D4].End(xlDown)).Resize(, 4)
ReDim dArr(1 To UBound(Arr, 1), 1 To 3)
Set Dic = CreateObject("Scripting.Dictionary")
With Dic
For i = 1 To UBound(Arr, 1)
Tmp = Arr(i, 1)
If Not .Exists(Tmp) Then
k = k + 1
.Add Tmp, k
dArr(k, 1) = Arr(i, 1)
If Arr(i, 3) = "X" Then
dArr(k, 2) = Arr(i, 4)
ElseIf Arr(i, 3) = "Y" Then
dArr(k, 3) = Arr(i, 4)
End If
Else
If (Arr(i, 3) = "X") And (Arr(i, 4) > dArr(.Item(Tmp), 2)) Then
dArr(.Item(Tmp), 2) = Arr(i, 4)
ElseIf (Arr(i, 3) = "Y") And (Arr(i, 4) > dArr(.Item(Tmp), 3)) Then
dArr(.Item(Tmp), 3) = Arr(i, 4)
End If
End If
Next i
End With
Sheet2.Range("A4:C65000").ClearContents
Sheet2.Range("A4").Resize(k, 3) = dArr
End Sub
Upvote
0
Cảm ơn 2 bác đã nhiệt tình giúp đỡ. Tiện đây e cũng cần lọc dữ liệu tương tự như bài 1 nhưng có khác chút, mong bác bớt tí thời gian giúp e cho trót. Lọc giá trị MAX cell cột E có cùng tên trong cell cột A sang sheet2. E gửi file đính kèm.
Upvote
0
Ba Tê
Cạo Rồi Khỏi Gội
- Tham gia
- 5/5/09
- Bài viết
- 12,124
- Được thích
- 17,588
- Giới tính
- Nam
Thử code này xem sao:
PHP:
Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), Tem As String
Dim I As Long, K As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Sheet1.Range("A4", Sheet1.Range("F4").End(xlDown)).Value
ReDim dArr(1 To UBound(sArr), 1 To 3)
For I = 1 To UBound(sArr, 1)
Tem = sArr(I, 1)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = sArr(I, 1)
End If
Rws = Dic.Item(Tem)
If dArr(Rws, 2) < sArr(I, 5) Then dArr(Rws, 2) = sArr(I, 5)
If dArr(Rws, 3) < sArr(I, 6) Then dArr(Rws, 3) = sArr(I, 6)
Next I
Sheet2.Range("A4:C1000").ClearContents
Sheet2.Range("A4:C4").Resize(K) = dArr
Set Dic = Nothing
End Sub
Upvote
0
Cảm ơn bác, code chạy Ok, nhưng bổ sung giùm e, cột E và F lấy giá trị Max giá trị tuyệt đối giùm e với. Do giá trị cột E, F có số âm và dương.
Upvote
0
Dạ lấy 500 bác ah. Cảm ơn bác.
Upvote
0
Ba Tê
Cạo Rồi Khỏi Gội
- Tham gia
- 5/5/09
- Bài viết
- 12,124
- Được thích
- 17,588
- Giới tính
- Nam
Nếu vậy thì thay Sub bài #8 bằng cái này:
PHP:
Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), Tem As String
Dim I As Long, K As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Sheet1.Range("A4", Sheet1.Range("F4").End(xlDown)).Value
ReDim dArr(1 To UBound(sArr), 1 To 3)
For I = 1 To UBound(sArr, 1)
Tem = sArr(I, 1)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = sArr(I, 1)
End If
Rws = Dic.Item(Tem)
If dArr(Rws, 2) < Abs(sArr(I, 5)) Then dArr(Rws, 2) = Abs(sArr(I, 5))
If dArr(Rws, 3) < Abs(sArr(I, 6)) Then dArr(Rws, 3) = Abs(sArr(I, 6))
Next I
Sheet2.Range("A4:C1000").ClearContents
Sheet2.Range("A4:C4").Resize(K) = dArr
Set Dic = Nothing
End SubTìm lại kết quả trong dữ liệu thì không kể dấu, vậy khi tạo bảng dữ liệu không "tuyệt đối" nó trước cho rồi.
Upvote
0
Do bảng dữ liệu e xuất từ phần mềm ra có giá trị âm dương. Muốn rút gọn thời gian không phải qua một bước "tuyệt đối" nên e mới làm phiền bác. Cảm ơn bác nhiều.
Upvote
0
Bài viết mới nhất
- Question
- Question
- Đã giải quyết
- Question