Tìm giá trị MAX - MIN có điều kiện?

nad582 · 25/7/14

Chào các a(c) trong GPE, e có số liệu cột C và giá trị cột O
yêu cầu tìm giá trị lớn nhất cột O ứng với cột C, sau đó tô đậm giá trị lớn nhất vừa tìm..
ghi chú: nếu có thể các a(c) viết code càng đơn giản càng tốt, hoặc nếu code dài dòng nhưng cụ thể để e từ từ ngâm....cứu
và không qua bước trung gian nào nhe...!!
( cho biến i đi từ trên xuống dưới ứng cột O với tên cột C thấy số nào lớn nhất thì đánh dấu nó-tô dậm,...cứ tiếp tục xuống)

e chân thành cảm ơn

Quang_Hải · 26/7/14

hungpecc1 đã viết:

Với dữ liệu như bài này (#1) , em thử code sau vẫn đúng :

Mã:

Sub GPE()
    Dim tmparr, Arr()
    Dim i&, n&
        tmparr = Range("A14:O21")
        ReDim Arr(1 To 1): n = 1
        [COLOR=#ff0000][B]For[/B][/COLOR] i = 1 To UBound(tmparr, 1) - 1
            If tmparr(i + 1, 3) <> tmparr(i, 3) Then
                n = n + 1
                ReDim Preserve Arr(1 To n): Arr(n) = "O" & 13 + i + 1
            Else
               If tmparr(i, 15) < tmparr(i + 1, 15) Then Arr(n) = "O" & 13 + i + 1
            End If
[B][COLOR=#ff0000]        Next[/COLOR][/B]
        Range(Join(Arr, ",")).Interior.Color = vbGreen
End Sub

Qua trải nghiệm thì mình thấy rằng nếu dữ liệu nhiều thì sẽ bị lỗi tại dòng code cuối, hình như chỉ chịu nổi 55 vùng thì phải, qua tới vùng 56 là lỗi ngay

nad582 · 26/7/14

hungpecc1 đã viết:
Thật ra với bài này bạn Nad582 có thể sử dụng công thức tìm giá trị lớn nhất thoả mãn 1 điều kiên : Max(If()) --> sau đó record marco là có code ngay , mình ví dụ với dữ liệu bài #1 bạn gửi :

Mã:

Sub Macro3() Application.ScreenUpdating = False ' Tao vung Criteria Range("O13").Copy Range("R13") Range("R14").FormulaArray =[B][COLOR=#ff0000] "=MAX(IF($C$14:$C$21=$C14,$O$14:$O$21,""""))"[/COLOR][/B] Range("R14").Copy Range("R15:R21") Range("O14:O21").Interior.Color = xlNone 'Loc du lieu [COLOR=#ff0000][B]Range("O13:O21").AdvancedFilter xlFilterInPlace, Range("R13:R21")[/B][/COLOR] Range("O14:O21").SpecialCells(xlCellTypeVisible).Interior.Color = vbGreen 'Tro ve du lieu ban dau ActiveSheet.ShowAllData Range("R13:R21").Clear Application.ScreenUpdating = True End Sub

Xem ra bài này của a e có thể sử dụng hơn 1 điều kiện(sử dụng được nhiều điều kiện), thank you!!
Nhưng khi số liệu có số lớn nhất trùng nhau thì nó đánh dấu luôn cả các số đó, vậy có thể đánh dấu số đầu tiên thôi được ko?
xina cho ý kiến

hungpecc1 · 26/7/14

nad582 đã viết:
Xem ra bài này của a e có thể sử dụng hơn 1 điều kiện(sử dụng được nhiều điều kiện), thank you!!
Nhưng khi số liệu có số lớn nhất trùng nhau thì nó đánh dấu luôn cả các số đó, vậy có thể đánh dấu số đầu tiên thôi được ko?
xina cho ý kiến

thử sửa chỗ đo đỏ thành thế này xem thế nào :

Mã:

[COLOR=#FF0000][FONT=Verdana]Range("O13:O21").AdvancedFilter xlFilterInPlace, Range("R13:R21"), , True[/FONT][/COLOR]

hungpecc1 · 26/7/14

quanghai1969 đã viết:
Qua trải nghiệm thì mình thấy rằng nếu dữ liệu nhiều thì sẽ bị lỗi tại dòng code cuối, hình như chỉ chịu nổi 55 vùng thì phải, qua tới vùng 56 là lỗi ngay

chính xác là vậy, đây cũng là vấn đề lớn nhất trong hướng đi 1 vòng lặp của em : cấu trúc Range("...") chỉ được tối đa là 30 đối số thì phải

hungpecc1 · 26/7/14

quanghai1969 đã viết:
Qua trải nghiệm thì mình thấy rằng nếu dữ liệu nhiều thì sẽ bị lỗi tại dòng code cuối, hình như chỉ chịu nổi 55 vùng thì phải, qua tới vùng 56 là lỗi ngay

Em thử vá lỗi lần 1:

Mã:

Sub GPE()
Application.ScreenUpdating = False
    Dim tmparr, Arr(), Arrvalue()
    Dim i&, n&
        tmparr = Range("A14:O21")
        ReDim Arr(1 To 1):      n = 1:      Arr(1) = 14
        ReDim Arrvalue(1 To 1)
        [COLOR=#ff0000]For [/COLOR]i = 1 To UBound(tmparr, 1) - 1
            If tmparr(i + 1, 3) <> tmparr(i, 3) Then
                n = n + 1
                ReDim Preserve Arr(1 To n):         Arr(n) = 13 + i + 1
                ReDim Preserve Arrvalue(1 To n):    Arrvalue(n) = tmparr(i + 1, 15)
            Else
               If Arrvalue(n) < tmparr(i + 1, 15) Then
                    Rows(Arr(n)).EntireRow.Hidden = True
                    Arr(n) = 13 + i + 1
                    Arrvalue(n) = tmparr(i + 1, 15)
                Else
                   Rows(13 + i + 1).EntireRow.Hidden = True
                End If
            End If
[COLOR=#ff0000]        Next[/COLOR]
        Range("O14:O21").SpecialCells(xlCellTypeVisible).Interior.Color = vbYellow
        Range("O13:O21").EntireRow.Hidden = False
Application.ScreenUpdating = True
End Sub

nad582 · 26/7/14

concogia đã viết:

Nếu dữ liệu vẫn thế thì dùng code này:

Mã:

Public Sub TimMax()
    Dim Vung, VungDo, I, J, iMaxO, iMaxP, iNhay, Wf, ktO, ktP
        Application.ScreenUpdating = False
            Set Wf = Application.WorksheetFunction
            Set Vung = Range([C14], [C50000].End(xlUp))
            I = 1
                Do While I <= Vung.Rows.Count
                    iNhay = Wf.CountIf(Vung, Vung(I))
                    Set VungDo = Vung(I).Resize(iNhay)
                    iMaxO = Wf.Max(VungDo.Offset(, 12))
                    iMaxP = Wf.Max(VungDo.Offset(, 13))
                        For J = 1 To iNhay
                            If VungDo(J).Offset(, 12) = iMaxO And ktO = 0 Then VungDo(J).Offset(, 12).Font.Bold = True: ktO = 1
                            If VungDo(J).Offset(, 13) = iMaxP And ktP = 0 Then VungDo(J).Offset(, 13).Font.Bold = True: ktP = 1
                        Next J
                    I = I + iNhay: ktO = 0: ktP = 0
                Loop
        Application.ScreenUpdating = True
End Sub

Thân
Hoặc thế này cho gọn hơn:

Mã:

Public Sub TimMax()
    Dim Vung, VungDo, I, iNhay, Wf
        Application.ScreenUpdating = False
            Set Wf = Application.WorksheetFunction
            Set Vung = Range([C14], [C50000].End(xlUp))
            Vung.Offset(, 12).Resize(, 2).Font.Bold = False
            I = 1
                Do While I <= Vung.Rows.Count
                    iNhay = Wf.CountIf(Vung, Vung(I))
                    Set VungDo = Vung(I).Resize(iNhay)
                            VungDo(Wf.Match(Wf.Max(VungDo.Offset(, 12)), VungDo.Offset(, 12), 0)).Offset(, 12).Font.Bold = True
                            VungDo(Wf.Match(Wf.Max(VungDo.Offset(, 13)), VungDo.Offset(, 13), 0)).Offset(, 13).Font.Bold = True
                    I = I + iNhay
                Loop
        Application.ScreenUpdating = True
End Sub

nếu dữ liệu của e như hình thì hình như code ko còn đúng phải ko a, nó sẽ lấy giá trị lớn nhất của ứng với tên ở cột C(mặc dù tên cột C ko liên tục)
vậy a có thể sửa lại giúp e,cho dù tên cột C giống nhau nhưng nó không liên tục thì xem như những tên trùng nhau ko liên tục đó là riêng biệt,
như vậy vẫn tìm giá trị lớn nhất ứng với những tên giống nhau ko liên tục!!

mong a cho ý kiến!! e cảm ơn

Quang_Hải · 26/7/14

nad582 đã viết:
nếu dữ liệu của e như hình thì hình như code ko còn đúng phải ko a, nó sẽ lấy giá trị lớn nhất của ứng với tên ở cột C(mặc dù tên cột C ko liên tục)
vậy a có thể sửa lại giúp e,cho dù tên cột C giống nhau nhưng nó không liên tục thì xem như những tên trùng nhau ko liên tục đó là riêng biệt,
như vậy vẫn tìm giá trị lớn nhất ứng với những tên giống nhau ko liên tục!!
View attachment 126179
mong a cho ý kiến!! e cảm ơn

Chắc chắn là không đúng vì dk tại cột C không phải la duy nhất
Cho nên phải áp dụng code lúc đầu của anh Cò

nad582 · 26/7/14

quanghai1969 đã viết:
Chắc chắn là không đúng vì dk tại cột C không phải la duy nhất

có thể điều chỉnh lại được ko a?

quanghai1969 đã viết:
Cho nên phải áp dụng code lúc đầu của anh Cò

anh Cò là bài mấy vậy a!!
e cảm ơn!!

Quang_Hải · 26/7/14

nad582 đã viết:
có thể điều chỉnh lại được ko a?

anh Cò là bài mấy vậy a!!
e cảm ơn!!

Thì đọc hết các bài giải đi, coi code nào đúng kết quả và thấy thích nhất thì chơi thôi.
Nếu dữ liệu chỉ trên khoảng 10 000 dòng thì dùng cách xử lý trên sheet cho gọn, dễ điều chỉnh code
Chạy mất 1s thôi
Cách giải thì có quá nhiều rồi mà

nad582 · 26/7/14

quanghai1969 đã viết:
Thì đọc hết các bài giải đi, coi code nào đúng kết quả và thấy thích nhất thì chơi thôi.
Nếu dữ liệu chỉ trên khoảng 10 000 dòng thì dùng cách xử lý trên sheet cho gọn, dễ điều chỉnh code
Chạy mất 1s thôi
Cách giải thì có quá nhiều rồi mà

E thử tất cả rồi a!! nói chung là đúng với trường hợp tên ở cột C là ko trùng nhau!!
nhưng e điều chỉnh mãi mà làm ko được nếu như tên cột C trùng nhau mà ko liên tục!!
a xem giúp e bài #26, e chân thành cảm ơn!!
(vì sáng nay e áp dụng vào bài tập thì phát hiện tên ở cột C có trùng và ko liên tục)

Quang_Hải · 26/7/14

nad582 đã viết:
E thử tất cả rồi a!! nói chung là đúng với trường hợp tên ở cột C là ko trùng nhau!!
nhưng e điều chỉnh mãi mà làm ko được nếu như tên cột C trùng nhau mà ko liên tục!!
a xem giúp e bài #26, e chân thành cảm ơn!!
(vì sáng nay e áp dụng vào bài tập thì phát hiện tên ở cột C có trùng và ko liên tục)

Hay là thử tạm code này coi sao.
Code này đơn giản, có thể tự phát triển thêm

PHP:

Sub t1()
Dim r, Fr, n, rng1, rng2
r = 14
Do
   If n = 0 Then Fr = r
   If Cells(r, 3) = Cells(r + 1, 3) Then
      n = n + 1
   Else
      Set rng1 = Range(Cells(Fr, 15), Cells(r, 15))
      Set rng2 = rng1.Offset(, 1)
      rng1.Find(Application.Max(rng1)).Interior.Color = vbCyan
      rng2.Find(Application.Max(rng2)).Interior.Color = vbCyan
      n = 0
   End If
   r = r + 1
Loop Until Cells(r, 3) = ""
End Sub

Khi nào khá hơn chút thì xử bằng mảng

nad582 · 26/7/14

hungpecc1 đã viết:
thử sửa chỗ đo đỏ thành thế này xem thế nào :

Mã:

[COLOR=#FF0000][FONT=Verdana]Range("O13:O21").AdvancedFilter xlFilterInPlace, Range("R13:R21"), , True[/FONT][/COLOR]

anh hungpecc1 nếu e dùng code trên thì nó chỉ tìm Max ở khung e đánh dấu ak

nếu e dùng code:

Mã:

Range("O13:O210").AdvancedFilter xlFilterInPlace, Range("R13:R210")

khung màu đỏ thì thì ra giá trị Max nhưng có thể lấy 1 giá trị max được ko ak?
còn khung màu xanh thì nó ko lấy luôn?
có thể điều chỉnh lại 2 trường hợp trên được ko a?
đây là kết quả ở bài #31

(kết quả rất đúng)
e chân thành cảm ơn!!

Quang_Hải · 26/7/14

nad582 đã viết:
anh hungpecc1 nếu e dùng code trên thì nó chỉ tìm Max ở khung e đánh dấu ak
View attachment 126187

nếu e dùng code:

Mã:

Range("O13:O210").AdvancedFilter xlFilterInPlace, Range("R13:R210")

View attachment 126189
khung màu đỏ thì thì ra giá trị Max nhưng có thể lấy 1 giá trị max được ko ak?
còn khung màu xanh thì nó ko lấy luôn?
có thể điều chỉnh lại 2 trường hợp trên được ko a?
đây là kết quả ở bài #31
View attachment 126190 (kết quả rất đúng)
e chân thành cảm ơn!!

Cũng tương tự các code phía trên nhưng cho vào mảng để tìm chắc sẽ nhanh hơn tí tẹo

PHP:

Sub t2()
Dim data(), n, i, Fr, rng
data = Range([C14], [C65536].End(3).Offset(1)).Value
i = 1
Do
   If n = 0 Then Fr = i
   If data(i, 1) = data(i + 1, 1) Then
      n = 1
   Else
      Set rng = Range("O" & Fr + 13 & ":O" & i + 13)
      rng.Find(Application.Max(rng)).Interior.Color = vbCyan
      rng.Offset(, 1).Find(Application.Max(rng.Offset(, 1))).Interior.Color = vbCyan
      n = 0
   End If
   i = i + 1
Loop Until i >= UBound(data)
End Sub

nad582 · 26/7/14

quanghai1969 đã viết:
Hay là thử tạm code này coi sao.
Code này đơn giản, có thể tự phát triển thêm

PHP:

Sub t1() Dim r, Fr, n, rng1, rng2 r = 14 Do If n = 0 Then Fr = r If Cells(r, 3) = Cells(r + 1, 3) Then n = n + 1 Else Set rng1 = Range(Cells(Fr, 15), Cells(r, 15)) Set rng2 = rng1.Offset(, 1) rng1.Find(Application.Max(rng1)).Interior.Color = vbCyan rng2.Find(Application.Max(rng2)).Interior.Color = vbCyan n = 0 End If r = r + 1 Loop Until Cells(r, 3) = "" End Sub

Khi nào khá hơn chút thì xử bằng mảng

sorry a quanghai1969, bây giờ e muốn tô màu ở cột C ko phải cột O nữa thì phải điều chỉnh thế nào vậy a?
tức nghĩa là vẫn tìm giá trị Max ở cột O nhưng thay vì đánh dấu giá trị Max đó thì ta đánh dấu sang cột C
View attachment 126193
mong anh giúp đỡ!! cảm ơn nhiều!!

Quang_Hải · 26/7/14

nad582 đã viết:
sorry a quanghai1969, bây giờ e muốn tô màu ở cột C ko phải cột O nữa thì phải điều chỉnh thế nào vậy a?
tức nghĩa là vẫn tìm giá trị Max ở cột O nhưng thay vì đánh dấu giá trị Max đó thì ta đánh dấu sang cột C
View attachment 126193
mong anh giúp đỡ!! cảm ơn nhiều!!

Thử vọc phá với cái thuộc tính OFFSET đi sẽ được
Cú pháp: Range.Offset(Row, CoLumn). Nếu Row là số âm thì lên phía trên, dương thì xuống dưới. Column dương thì qua phải, âm thì qua trái

nad582 · 26/7/14

quanghai1969 đã viết:
Thử vọc phá với cái thuộc tính OFFSET đi sẽ được
Cú pháp: Range.Offset(Row, CoLumn). Nếu Row là số âm thì lên phía trên, dương thì xuống dưới. Column dương thì qua phải, âm thì qua trái

Sorry a, e ko hiểu về cách làm sao để bố trí code vào đâu, nên vọc phá bị lỗi miết....
nhờ a giúp dùm e luôn,...từ từ e rút ra sau vậy!!
lưu ý: thay vì đánh dấu giá trị Max ở cột O... thì chỉ đánh dấu cột C thôi
e chân thành cảm ơn

Quang_Hải · 26/7/14

nad582 đã viết:
Sorry a, e ko hiểu về cách làm sao để bố trí code vào đâu, nên vọc phá bị lỗi miết....
nhờ a giúp dùm e luôn,...từ từ e rút ra sau vậy!!
lưu ý: thay vì đánh dấu giá trị Max ở cột O... thì chỉ đánh dấu cột C thôi
e chân thành cảm ơn

Phải thế này không?

PHP:

Sub t2()
Dim data(), n, i, Fr, rng
data = Range([C14], [C65536].End(3).Offset(1)).Value
i = 1
Do
   If n = 0 Then Fr = i
   If data(i, 1) = data(i + 1, 1) Then
      n = 1
   Else
      Set rng = Range("O" & Fr + 13 & ":O" & i + 13)
      rng.Find(Application.Max(rng)).Offset(, -12).Interior.Color = vbCyan
      rng.Offset(, 1).Find(Application.Max(rng.Offset(, 1))).Offset(, -13).Interior.Color = vbCyan
      n = 0
   End If
   i = i + 1
Loop Until i >= UBound(data)
End Sub

nad582 · 26/7/14

quanghai1969 đã viết:

Phải thế này không?

PHP:

Sub t2()
Dim data(), n, i, Fr, rng
data = Range([C14], [C65536].End(3).Offset(1)).Value
i = 1
Do
   If n = 0 Then Fr = i
   If data(i, 1) = data(i + 1, 1) Then
      n = 1
   Else
      Set rng = Range("O" & Fr + 13 & ":O" & i + 13)
      rng.Find(Application.Max(rng)).Offset(, -12).Interior.Color = vbCyan
      rng.Offset(, 1).Find(Application.Max(rng.Offset(, 1))).Offset(, -13).Interior.Color = vbCyan
      n = 0
   End If
   i = i + 1
Loop Until i >= UBound(data)
End Sub

sau 1 hồi mò theo chỉ dẫn của a e làm thế này ko biết có được ko a!!(có bị sai ko anh)

Mã:

Sub t1()
Dim r, Fr, n, rng1, rng2, mg3
r = 14
Do
   If n = 0 Then Fr = r
   If Cells(r, 2) = Cells(r + 1, 2) Then
      n = n + 1
   Else
      Set rng1 = Range(Cells(Fr, 15), Cells(r, 15))
      Set rng2 = rng1.Offset(, 1)
      Set rng3 = rng1.Offset(, 2)
      rng1.Find(Application.Min(rng1)).Offset(0, -12).Interior.Color = vbCyan
      rng2.Find(Application.Min(rng2)).Offset(0, -13).Interior.Color = vbCyan
      rng3.Find(Application.Min(rng3)).Offset(0, -14).Interior.Color = vbCyan
      
      n = 0
   End If
   r = r + 1
Loop Until Cells(r, 3) = ""
End Sub

a kiểm tra giúp e!!

nad582 · 26/7/14

Thưa các a(c), với đoạn code trên:

Mã:

Sub t1()
Dim r, Fr, n, rng1, rng2, mg3
r = 14
Do
   If n = 0 Then Fr = r
   If Cells(r, 2) = Cells(r + 1, 2) Then
      n = n + 1
   Else
      Set rng1 = Range(Cells(Fr, 15), Cells(r, 15))
      Set rng2 = rng1.Offset(, 1)
      Set rng3 = rng1.Offset(, 2)
      rng1.Find(Application.Min(rng1)).Offset(0, -12).Interior.Color = vbCyan
      rng2.Find(Application.Min(rng2)).Offset(0, -13).Interior.Color = vbCyan
      rng3.Find(Application.Min(rng3)).Offset(0, -14).Interior.Color = vbCyan
      
      n = 0
   End If
   r = r + 1
Loop Until Cells(r, 3) = ""
End Sub

Nếu như cột O,P,Q có giá trị âm(-), dương(+) xen kẻ thì e muốn cho dù giá trị âm hay dương khi tìm Max(trị tuyệt đối) Max luôn luôn là số dương, có nghĩa là cho tất cả giá trị đó đều là dương hết!!
xin các a(c) cho ý kiến,...mong hồi âm...!!

nad582 · 28/7/14

Chào các a(c) trong GPE, xin các a(C) giúp cho e bài #39, e đợi 2 ngày rồi mà chưa thấy hồi âm...!!
e chân thành cảm ơn..!1

Tìm giá trị MAX - MIN có điều kiện?

Thành viên thường trực

File đính kèm

Thành viên gạo cội

Thành viên thường trực

Thành viên gắn bó

Thành viên gắn bó

Thành viên gắn bó

Thành viên thường trực

File đính kèm

Thành viên gạo cội

Thành viên thường trực

Thành viên gạo cội

Thành viên thường trực

Thành viên gạo cội

Thành viên thường trực

File đính kèm

Thành viên gạo cội

Thành viên thường trực

Thành viên gạo cội

Thành viên thường trực

Thành viên gạo cội

Thành viên thường trực

Thành viên thường trực

Thành viên thường trực

Đếm ngược thời gian