Tìm giá trị MAX - MIN có điều kiện? (1 người xem)

  • Thread starter Thread starter nad582
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
nad582

nad582

Thành viên thường trực
Tham gia
7/6/11
Bài viết
317
Được thích
48
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)
2014-07-25_17-33-58.jpg
e chân thành cảm ơn
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Là mình làm như thế này

PHP: 
Option Explicit
Sub Macro1()
 Dim Cls As Range, Rng As Range, sRng As Range, WF As Object, Rg0 As Range
 Dim fAdd As String, Min_ As Double, MyAdd As String
 
 Set Rng = Range([c13], [c13].End(xlDown))
 Rng.AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=Range("AB1"), Unique:=True
 Set Rg0 = Range([o13], [o13].End(xlDown))
 For Each Cls In Range([AB2], [AB1].End(xlDown))
    Min_ = Application.WorksheetFunction.Min(Rg0) - 1
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        fAdd = sRng.Address
        Do
            With Cells(sRng.Row, "O")
                If Min_ < .Value Then
                    Min_ = .Value
                    MyAdd = .Address
                End If
            End With
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> fAdd
        Range(MyAdd).Interior.ColorIndex = 34 + Range(MyAdd).Row Mod 9
    End If
 Next Cls
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn a ChanhTQ@ đã góp bài giúp e, trong bài của a có sử dụng qua bước trung gian(chỗ a tô màu đỏ "AB1"). Xin hỏi các a(c) còn cách nào khác không? ko qua bước trung gian!!

ghu chú: nếu dò từ trên xuống mà giá trị Max trùng nhau thì lấy giá trị đầu tiên!!
e chân thành cảm ơn
 
Lần chỉnh sửa cuối:
Upvote 0
nad582 đã viết:
Cảm ơn a ChanhTQ@ đã góp bài giúp e, trong bài của a có sử dụng qua bước trung gian(chỗ a tô màu đỏ "AB1"). Xin hỏi các a(c) còn cách nào khác không? ko qua bước trung gian!!

ghu chú: nếu dò từ trên xuống mà giá trị Max trùng nhau thì lấy giá trị đầu tiên!!
e chân thành cảm ơn
Nhấp chuột vào đây để mở rộng...
Qua trung gian một cái "Dic" được không?
[GPECODE=vb]Public Sub GPE()
Application.ScreenUpdating = False
Dim Dic As Object, sArr(), I As Long, K As Long, Rng As Range, Cll As Range, Tem As Variant
Set Dic = CreateObject("Scripting.Dictionary")
Set Rng = Range([C14], [C65536].End(xlUp))
sArr = Rng.Resize(, 13).Value
For I = 1 To UBound(sArr, 1)
Tem = sArr(I, 1)
If Not Dic.Exists(Tem) Then
Dic.Add Tem, sArr(I, 13)
Else
If Dic.Item(Tem) < sArr(I, 13) Then Dic.Item(Tem) = sArr(I, 13)
End If
Next I
For Each Cll In Rng
If Dic.Item(Cll.Value) = Cll.Offset(, 12).Value Then
Cll.Offset(, 12).Font.ColorIndex = 3
End If
Next Cll
Set Rng = Nothing
Set Dic = Nothing
Application.ScreenUpdating = True
End Sub[/GPECODE]
 
Upvote 0
nad582 đã viết:
Cảm ơn a ChanhTQ@ đã góp bài giúp e, trong bài của a có sử dụng qua bước trung gian(chỗ a tô màu đỏ "AB1"). Xin hỏi các a(c) còn cách nào khác không? ko qua bước trung gian!!

ghu chú: nếu dò từ trên xuống mà giá trị Max trùng nhau thì lấy giá trị đầu tiên!!
e chân thành cảm ơn
Nhấp chuột vào đây để mở rộng...
Nếu không thích dùng AdvancedFiler như bài trên, thì thử dùng scripting.dictionary xem nào :
Mã: 
Option Explicit
Sub GPE()
    Dim ArrName(), ArrValue(), Arr#()
    Dim i&, j&, n&, tmp
        ArrName = Range("C14", [C65536].End(3))
        ArrValue = Range("O14", [O65536].End(3))
        ReDim Arr(1 To UBound(ArrName, 1), 1 To 2)
        '____________________________________________
        With CreateObject("Scripting.Dictionary")
            For i = 1 To UBound(ArrName, 1)
                tmp = Trim(ArrName(i, 1))
                If Len(tmp) Then
                    If Not .exists(tmp) Then
                        n = n + 1
                        .Add tmp, n
                        Arr(n, 1) = ArrValue(i, 1): Arr(n, 2) = i
                    Else
                        j = .Item(tmp)
                        If Arr(j, 1) < ArrValue(i, 1) Then
                            Arr(j, 1) = ArrValue(i, 1): Arr(j, 2) = i
                        End If
                    End If
                End If
            Next
        End With
        '___________________________________________________
        If n Then
            Range("O14", [O65536].End(3)).Interior.Color = xlNone
            For i = 1 To n
                Range("O" & Arr(i, 2) + 13).Interior.Color = vbYellow
            Next
        End If
End Sub
 
Upvote 0
nad582 đã viết:
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)
View attachment 126138
e chân thành cảm ơn
Nhấp chuột vào đây để mở rộng...
Nếu dữ liệu đã được sắp xếp như trong bài, bạn thử dùng code này xem:
Mã: 
Public Sub TimMax()
    Dim Vung, VungDo, I, J, iMax, iNhay, Wf
        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)
                    iMax = Wf.Max(VungDo.Offset(, 12))
                        For J = 1 To iNhay
                            If VungDo(J).Offset(, 12) = iMax Then VungDo(J).Offset(, 12).Font.Bold = True: Exit For
                        Next J
                    I = I + iNhay
                Loop
        Application.ScreenUpdating = True
End Sub
Thân
 
Upvote 0
ok. Mỗi a(c) đều có những code khác nhau, thật là tuyệt vời khi học đc nhiều cái mới, tất cả đều hoàn hảo!!
Nếu dữ liệu e có thêm 1 cột nữa, cách thức vẫn tìm giá trị lớn nhất và tô đậm nó!! mong các a(c) giúp e!!
2014-07-25_23-41-33.jpg
tóm lại là tìm giá trị lớn nhất của cột O và P sau đó tô đậm nó ứng với cột C.
(lý do vì e muốn tìm hiểu khi khai báo tìm max 1 cột có khác gì với tìm max 2 hay nhiều cột không? để tiện điều chỉnh trong bài của mình)
Chân thành cảm ơn!!
 

File đính kèm

Upvote 0
nad582 đã viết:
Cảm ơn a ChanhTQ@ đã góp bài giúp e, trong bài của a có sử dụng qua bước trung gian(chỗ a tô màu đỏ "AB1"). Xin hỏi các a(c) còn cách nào khác không? ko qua bước trung gian!!

ghu chú: nếu dò từ trên xuống mà giá trị Max trùng nhau thì lấy giá trị đầu tiên!!
e chân thành cảm ơn
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub GPE()
Dim cnn As Object, lsSQL As String, lrs As Object, rng As Range
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & ThisWorkbook.FullName & _
                        ";Extended Properties=""Excel 12.0;HDR=yes;"";"
       
        .Open
    End With
    lsSQL = "SELECT MAX(O) FROM [Sheet1$A13:Q65536] GROUP BY C "
    lrs.Open lsSQL, cnn, 3, 1, 1
    Range("O14", [O65536].End(3)).Interior.Color = xlNone
    lrs.MoveFirst
    Do While Not lrs.EOF
        Set rng = Range("O14", [O65536].End(3)).Find(lrs(0), , xlFormulas, xlPart)
        rng.Interior.Color = vbYellow
        lrs.MoveNext
    Loop
Set lrs = Nothing
cnn.Close: Set cnn = Nothing
End Sub
 
Upvote 0
nad582 đã viết:
ok. Mỗi a(c) đều có những code khác nhau, thật là tuyệt vời khi học đc nhiều cái mới, tất cả đều hoàn hảo!!
Nếu dữ liệu e có thêm 1 cột nữa, cách thức vẫn tìm giá trị lớn nhất và tô đậm nó!! mong các a(c) giúp e!!
View attachment 126153
tóm lại là tìm giá trị lớn nhất của cột O và P sau đó tô đậm nó ứng với cột C.
(lý do vì e muốn tìm hiểu khi khai báo tìm max 1 cột có khác gì với tìm max 2 hay nhiều cột không? để tiện điều chỉnh trong bài của mình)
Chân thành cảm ơn!!
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub GPE()
Dim cnn As Object, lsSQL As String, lrs As Object, rng As Range
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & ThisWorkbook.FullName & _
                        ";Extended Properties=""Excel 12.0;HDR=yes;"";"
       
        .Open
    End With
    lsSQL = "SELECT [B]MAX(O),MAX(P) [/B]FROM [Sheet1$A13:Q65536] GROUP BY C "
    lrs.Open lsSQL, cnn, 3, 1, 1
    Range("O14", [P65536].End(3)).Interior.Color = xlNone
    lrs.MoveFirst
    Do While Not lrs.EOF
        Set rng = [B]Range("O14", [P65536].End(3)).[/B]Find(lrs(0), , xlFormulas, xlPart)
        rng.Interior.Color = vbYellow
        Set rng = [B]Range("O14", [P65536].End(3)).[/B]Find(lrs(1), , xlFormulas, xlPart)
        rng.Interior.Color = vbYellow
        lrs.MoveNext
    Loop

Set lrs = Nothing
cnn.Close: Set cnn = Nothing
End Sub
 
Upvote 0
hungpecc1 đã viết:
Mã: 
Sub GPE()
Dim cnn As Object, lsSQL As String, lrs As Object, rng As Range
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & ThisWorkbook.FullName & _
                        ";Extended Properties=""Excel 12.0;HDR=yes;"";"
       
        .Open
    End With
    lsSQL = "SELECT [B]MAX(O),MAX(P) [/B]FROM [Sheet1$A13:Q65536] GROUP BY C "
    lrs.Open lsSQL, cnn, 3, 1, 1
    Range("O14", [P65536].End(3)).Interior.Color = xlNone
    lrs.MoveFirst
    Do While Not lrs.EOF
        Set rng = [B]Range("O14", [P65536].End(3)).[/B]Find(lrs(0), , xlFormulas, xlPart)
        rng.Interior.Color = vbYellow
        Set rng = [B]Range("O14", [P65536].End(3)).[/B]Find(lrs(1), , xlFormulas, xlPart)
        rng.Interior.Color = vbYellow
        lrs.MoveNext
    Loop

Set lrs = Nothing
cnn.Close: Set cnn = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn, A hungpecc1.
Chỗ lsSQL = "SELECT MAX(O),MAX(P) FROM [Sheet1$A13:Q65536] GROUP BY C "
Chỗ tô màu đỏ, e nghỉ a dựa vào tên tiêu đề của từng cột (các tiêu đề của các cột đó e chỉ nêu bài ví dụ thôi, nó ko cố định) vì vậy khi e điều chỉnh bài của e thì nó ko đúng!!
ví dụ như hình:
2014-07-26_00-24-29.jpg
như vậy phải đổi chỗ tô màu đỏ trong code thành tiêu đề đánh dấu như trong hình sao!!
mong a cho e ý kiến!! mong hồi âm!!
 
Upvote 0
concogia đã viết:
Nếu dữ liệu đã được sắp xếp như trong bài, bạn thử dùng code này xem:
Mã: 
Public Sub TimMax()
    Dim Vung, VungDo, I, J, iMax, iNhay, Wf
        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)
                    iMax = Wf.Max(VungDo.Offset(, 12))
                        For J = 1 To iNhay
                            If VungDo(J).Offset(, 12) = iMax Then VungDo(J).Offset(, 12).Font.Bold = True: Exit For
                        Next J
                    I = I + iNhay
                Loop
        Application.ScreenUpdating = True
End Sub
Thân
Nhấp chuột vào đây để mở rộng...
A concogia có thể giải quyết dùm e bài #7 luôn được ko? e cảm ơn!!
 
Upvote 0
Bài này thách mọi người không dùng Dic, không dùng ADO mà chỉ cần 1 vòng lặp duy nhất là ra kết quả
 
Upvote 0
nad582 đã viết:
Cảm ơn, A hungpecc1.
Chỗ lsSQL = "SELECT MAX(O),MAX(P) FROM [Sheet1$A13:Q65536] GROUP BY C "
Chỗ tô màu đỏ, e nghỉ a dựa vào tên tiêu đề của từng cột (các tiêu đề của các cột đó e chỉ nêu bài ví dụ thôi, nó ko cố định) vì vậy khi e điều chỉnh bài của e thì nó ko đúng!!
ví dụ như hình:
View attachment 126156
như vậy phải đổi chỗ tô màu đỏ trong code thành tiêu đề đánh dấu như trong hình sao!!
mong a cho e ý kiến!! mong hồi âm!!
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub GPE()
Dim cnn As Object, lsSQL As String, lrs As Object, rng As Range
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & ThisWorkbook.FullName & _
                        ";Extended Properties=""Excel 12.0;[COLOR=#ff0000][B]HDR=no[/B][/COLOR];"";"
       
        .Open
    End With
    lsSQL = "SELECT [COLOR=#ff0000][B]MAX(f15),MAX(f16)[/B][/COLOR] FROM [COLOR=#ff0000][B][Sheet1$A14:Q65536][/B][/COLOR] GROUP BY f3 "
    lrs.Open lsSQL, cnn, 3, 1, 1
    Range("O14", [P65536].End(3)).Interior.Color = xlNone
    lrs.MoveFirst
    Do While Not lrs.EOF
         Set rng = Range("O14", [P65536].End(3)).Find(Round(lrs(0), 2), LookIn:=xlValues, Lookat:=xlPart)       
         rng.Interior.Color = vbYellow
        Set rng = Range("O14", [P65536].End(3)).Find(Round(lrs(1), 2), LookIn:=xlValues, Lookat:=xlPart)
        rng.Interior.Color = vbYellow
        lrs.MoveNext
    Loop


Set lrs = Nothing
cnn.Close: Set cnn = Nothing
End Sub
* Lưu ý :
- chuỗi liên kết .connectionstring ở trên chỉ sử dụng cho excel 2007 trờ lên.
- Do trong code có sử dụng phương thức Find --> cần lưu ý :
...............Dấu phân cách giữa phần nguyên và phần thập phân phải được định dạng là dấu "."
............... Bạn phải xác định đúng định dạng dữ liệu, ... để tuỳ chỉnh tham số XlFormulas( xlVaules), Xlwhole(xlpart),...
................ Có thể viết vòng lặp for ... next thay cho việc sử dụng phương thức find
/.
 
Lần chỉnh sửa cuối:
Upvote 0
quanghai1969 đã viết:
Bài này thách mọi người không dùng Dic, không dùng ADO mà chỉ cần 1 vòng lặp duy nhất là ra kết quả
Nhấp chuột vào đây để mở rộng...
Bài này viết riêng 1 hàm tìm số lớn nhất tương ứng với 1 biến đk đưa vào. chương trình chính chỉ cho 1 vòng for duyệt qua rồi kiểm tra đk và sau đó muốn làm gì thì làm.
 
Upvote 0
nad582 đã viết:
A concogia có thể giải quyết dùm e bài #7 luôn được ko? e cảm ơn!!
Nhấp chuột vào đây để mở rộng...
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
Nguyên văn bởi quanghai1969 Bài này thách mọi người không dùng Dic, không dùng ADO mà chỉ cần 1 vòng lặp duy nhất là ra kết quả
Nhấp chuột vào đây để mở rộng...
Dữ liệu trong "Bài này" ra sao, bài này là.......bài nào ????
Híc
 
Lần chỉnh sửa cuối:
Upvote 0
nad582 đã viết:
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)
View attachment 126138
e chân thành cảm ơn
Nhấp chuột vào đây để mở rộng...

Nếu dãy AA,BB...là liên tiếp nhau không rời rạc thì dùng CF vẫn được
Bài này tạm tính theo phạm vi dữ liệu mẫu đã cho
 

File đính kèm

Upvote 0
phihndhsp đã viết:
Bài này viết riêng 1 hàm tìm số lớn nhất tương ứng với 1 biến đk đưa vào. chương trình chính chỉ cho 1 vòng for duyệt qua rồi kiểm tra đk và sau đó muốn làm gì thì làm.
Nhấp chuột vào đây để mở rộng...
Anh Hải đã ra bài toán thì chắc là không đơn giản vậy đâu :
* Trong toàn bộ code chỉ được xuất hiện 1 cấu trúc For .. Next, Do loop
* Còn việc có được sử dụng thêm các object, Component , ActiveX ,.. thì phải hỏi lại anh Hải

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
 
Upvote 0
phihndhsp đã viết:
Bài này viết riêng 1 hàm tìm số lớn nhất tương ứng với 1 biến đk đưa vào. chương trình chính chỉ cho 1 vòng for duyệt qua rồi kiểm tra đk và sau đó muốn làm gì thì làm.
Nhấp chuột vào đây để mở rộng...
Muốn viết hàm gì đó thì viết, miễn sao gom hết lại chỉ có 1 vòng lặp duy nhất là được.
concogia đã viết:
Dữ liệu trong "Bài này" ra sao, bài này là.......bài nào ????
Híc
Nhấp chuột vào đây để mở rộng...
Bài này là bài này, chứ sao lại bài này là bài nào hả anh?
Công nhận anh sử dụng cái hàm Match độc thiệt đó. Hay!
Yêu cầu của em là không cho duyệt trên sheet, khi nào tô màu mới cho xuống sheet tô
hungpecc1 đã viết:
Anh Hải đã ra bài toán thì chắc là không đơn giản vậy đâu :
* Trong toàn bộ code chỉ được xuất hiện 1 cấu trúc For .. Next, Do loop
* Còn việc có được sử dụng thêm các object, Component , ActiveX ,.. thì phải hỏi lại anh Hải
Nhấp chuột vào đây để mở rộng...
Chỉ dùng 1 mảng để dò tìm, khi nào muốn định dạng thì xuống sheet vậy thôi.
 
Lần chỉnh sửa cuối:
Upvote 0
quanghai1969 đã viết:
Muốn viết hàm gì đó thì viết, miễn sao gom hết lại chỉ có 1 vòng lặp duy nhất là được.

Bài này là bài này, chứ sao lại bài này là bài nào hả anh?
Công nhận anh sử dụng cái hàm Match độc thiệt đó. Hay!
Yêu cầu của em là không cho duyệt trên sheet, khi nào tô màu mới cho xuống sheet tô

Chỉ dùng 1 mảng để dò tìm, khi nào muốn định dạng thì xuống sheet vậy thôi.
Nhấp chuột vào đây để mở rộng...
Cuối tuần rồi mọi người ơi, tham gia đi cho vui. Cũng biết là chỉ dọa mấy anh em mới bập bẹ VBA thôi nhưng cũng la to to chút cho hào hứng tí
Dạo này mục lập trình ế quá mạng, không có cơ hội ôn tập gì ráo.
 
Upvote 0
quanghai1969 đã viết:
Cuối tuần rồi mọi người ơi, tham gia đi cho vui. Cũng biết là chỉ dọa mấy anh em mới bập bẹ VBA thôi nhưng cũng la to to chút cho hào hứng tí
Dạo này mục lập trình ế quá mạng, không có cơ hội ôn tập gì ráo.
Nhấp chuột vào đây để mở rộng...
Với dữ liệu như bài này (#1) , em thử code sau vẫn đúng :
Mã: 
Sub GPE()
    Dim tmparr, Arr(), Arrvalue()
    Dim i&, n&
        tmparr = Range("A14:O21")
        ReDim Arr(1 To 1): n = 1
        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) = "O" & 13 + i + 1
                ReDim Preserve Arrvalue(1 To n):    Arrvalue(n) = tmparr(i + 1, 15)
            Else
               If Arrvalue(n) < tmparr(i + 1, 15) Then
                    Arr(n) = "O" & 13 + i + 1
                    Arrvalue(n) = tmparr(i + 1, 15)
                End If
            End If
[COLOR=#ff0000]        Next[/COLOR]
        Range(Join(Arr, ",")).Interior.Color = vbGreen
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...

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]
 
Lần chỉnh sửa cuối:
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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!!
2014-07-26_13-09-57.jpg
mong a cho ý kiến!! e cảm ơn
 

File đính kèm

Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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ò
 
Lần chỉnh sửa cuối:
Upvote 0
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!!
Nhấp chuột vào đây để mở rộng...

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à
 
Upvote 0
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à
Nhấp chuột vào đây để mở rộng...
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)
 
Upvote 0
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)
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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]
Nhấp chuột vào đây để mở rộng...
anh hungpecc1 nếu e dùng code trên thì nó chỉ tìm Max ở khung e đánh dấu ak
2014-07-26_13-59-46.jpg

nếu e dùng code:
Mã: 
Range("O13:O210").AdvancedFilter xlFilterInPlace, Range("R13:R210")
2014-07-26_14-04-37.jpg
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
2014-07-26_14-09-04.jpg (kết quả rất đúng)
e chân thành cảm ơn!!
 

File đính kèm

Upvote 0
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!!
Nhấp chuột vào đây để mở rộng...

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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộ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!!
 
Lần chỉnh sửa cuối:
Upvote 0
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!!
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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!!
 
Lần chỉnh sửa cuối:
Upvote 0
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...!!
 
Upvote 0
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
 
Upvote 0
nad582 đã viết:
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
Nhấp chuột vào đây để mở rộng...
bạn đã tìm được code phù hợp theo ý mình? , bây giờ phát sinh muốn tìm Max(giá trị tuyệt đối) ,sẽ có 2 hướng đi cho bạn :
* Tạo cột phụ : cột này gôm các giá trị tuyệt đối của cột cần so sánh, cột này sẽ là cột tham chiếu trong code của bạn
* Tìm hiểu thêm về hàm Abs() trong VBA, thêm ABS( giá trị) vào các đoạn code có xuất hiện toán tử so sánh >,< ,=
 
Upvote 0
hungpecc1 đã viết:
bạn đã tìm được code phù hợp theo ý mình? , bây giờ phát sinh muốn tìm Max(giá trị tuyệt đối) ,sẽ có 2 hướng đi cho bạn :
* Tạo cột phụ : cột này gôm các giá trị tuyệt đối của cột cần so sánh, cột này sẽ là cột tham chiếu trong code của bạn
* Tìm hiểu thêm về hàm Abs() trong VBA, thêm ABS( giá trị) vào các đoạn code có xuất hiện toán tử so sánh >,< ,=
Nhấp chuột vào đây để mở rộng...
Đã dùng code rồi còn xúi thêm cột phụ là sao?
Trong code của mình thêm vài dòng nữa là xử ngọt cái yêu cầu của chủ thớt, tại mình thích lưng chừng thế đấy. Để cho đói thật đói thì ăn mới ngon.
*******
To: Nad582
Bài toán đơn giản, nhưng bạn nên suy nghĩ cách đi. Bảo đảm có cách rất đơn giản. Với code hiện tại chỉ thêm vào có tẹo nữa là được
Chắn chắn là phải có thêm hàm ABS() để lấy giá trị tuyệt đối

Phải để cho bạn suy nghĩ coi như phạt cái tội lúc đầu đưa dữ liệu lên 1 kiểu rồi sau đó phát sinh kiểu khác
 
Lần chỉnh sửa cuối:
Upvote 0
quanghai1969 đã viết:
Trong code của mình thêm vài dòng nữa là xử ngọt cái yêu cầu của chủ thớt, tại mình thích lưng chừng thế đấy. Để cho đói thật đói thì ăn mới ngon.
*******
To: Nad582
Bài toán đơn giản, nhưng bạn nên suy nghĩ cách đi. Bảo đảm có cách rất đơn giản. Với code hiện tại chỉ thêm vào có tẹo nữa là được
Chắn chắn là phải có thêm hàm ABS() để lấy giá trị tuyệt đối
Nhấp chuột vào đây để mở rộng...
a thật là bí ẩn, thật ko đơn giản hì hì, tạo nhiều điều bất ngờ cho người đặt câu hỏi!!
ko biết phải đặt cái ABS() ở đâu đây??????????????????
 
Upvote 0
quanghai1969 đã viết:
Đã dùng code rồi còn xúi thêm cột phụ là sao?
Nhấp chuột vào đây để mở rộng...
cái này là mẹo cho người sử dụng : khi đã có hàm tìm max của 1 cột rồi, người dùng không có khả năng chỉnh sửa code, hoặc là không có mã nguồn của code.Trường hợp phát sinh muốn tìm Max(trị tuyệt đối) --> thì phải tạo một cột phụ chứa các giá trị tuyệt đối, rồi dùng chính cột này làm tham chiếu cho hàm tìm max đã có --=0 cái này là tư duy nhạy bén cơ bản mà anh !
 
Upvote 0
hungpecc1 đã viết:
cái này là mẹo cho người sử dụng : khi đã có hàm tìm max của 1 cột rồi, người dùng không có khả năng chỉnh sửa code, hoặc là không có mã nguồn của code.Trường hợp phát sinh muốn tìm Max(trị tuyệt đối) --> thì phải tạo một cột phụ chứa các giá trị tuyệt đối, rồi dùng chính cột này làm tham chiếu cho hàm tìm max đã có --=0 cái này là tư duy nhạy bén cơ bản mà anh !
Nhấp chuột vào đây để mở rộng...
Đã nói là không dùng cột phụ mà, chỉ nhiêu đó thôi, ghép hàm ABS() vào code luôn chứ. Thách thách thách đó, viết đi. Mình nói đơn giản lắm. Ka ka ka
 
Upvote 0
Nếu cần tìm max các abs của các ô trong range thì có thể tìm max và min của range rồi so sánh trị tuyệt đối của 2 kết quả.
 
Upvote 0
nad582 đã viết:
e làm mãi mà ko ra đuọc, mong a giúp dùm e luôn...chân thành cảm ơn...
Nhấp chuột vào đây để mở rộng...
Dữ liệu vẫn là tại cột C, O, P nha. Mình viết sẵn đánh dấu cho 3 cột luôn. Không thích cái nào thì bỏ ra
PHP: 
Sub t2()
Dim data(), n, i, Fr, rng, a, b, c
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)
      a = rng.Find(Application.Max(rng))
      b = rng.Find(Application.Min(rng))
      c = IIf(Abs(b) > a, b, a)
      rng.Find(c).Interior.Color = vbCyan
      rng.Find(c).Offset(, -12).Interior.Color = vbCyan
      Set rng = rng.Offset(, 1)
      a = rng.Find(Application.Max(rng))
      b = rng.Find(Application.Min(rng))
      c = IIf(Abs(b) > a, b, a)
      rng.Find(c).Interior.Color = vbCyan
      rng.Find(c).Offset(, -13).Interior.Color = vbCyan
      n = 0
   End If
   i = i + 1
Loop Until i >= UBound(data)
End Sub
 
Upvote 0
tính nhầm. xin lỗi phải xoá
 
Lần chỉnh sửa cuối:
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
Chào a Hải và các a(c) trên GPE, e ứng dụng đoạn code trên vào bài tập của e như thế này:
Mã: 
Sub loc_gt()Application.ScreenUpdating = False
Dim r, Fr, n, mg4, mg5
r = 14
Do
   If n = 0 Then Fr = r
   If Cells(r, 3) = Cells(r + 1, 3) Then
      n = n + 1
   Else
      Set rng4 = Range(Cells(Fr, 15), Cells(r, 15)) 'cot O
      rng4.Find(Application.Max(rng4)).Offset(0, 0).Font.Bold = True
      rng4.Find(Application.Max(rng4)).Offset(0, -13).Font.ColorIndex = 1
      Set rng5 = Range(Cells(Fr, 16), Cells(r, 16)) 'cot P
      rng5.Find(Application.Max(rng5)).Offset(0, 0).Font.Bold = True
      rng5.Find(Application.Max(rng5)).Offset(0, -14).Font.ColorIndex = 1
      n = 0
   End If
   r = r + 1
Loop Until Cells(r, 3) = ""
Application.ScreenUpdating = True
End Sub
2014-09-10_10-02-52.jpg
Giá trị cột O, ứng với tên cột C khi tìm giá trị max thì:
nếu như các giá trị max đó trùng nhau hết thì ko cần đánh dấu.
nếu các giá trị max không trùng nhau hết thì đánh dấu thằng đầu tiên.
Ví dụ như hình trên:
ở dòng 32 đến 40 tên cột C là 0,00 ứng với giá trị ở cột O là 0,50 hết vậy với code phía trên thì phải hiệu chỉnh thế nào ạ!!
xin các a(c) chỉ giúp e cảm ơn ! mong hồi âm!!
 

File đính kèm

Upvote 0
mong các a(c) giúp e, e đợi hơn 1 ngày rồi mà chưa nhận được hồi âm!! e cũng có chỉnh sửa mà bị lỗi suốt, ngồi mò mõi cả lưng mà ko ra!! mong sự hồi âm của a(c). e chân thành cảm ơn
 
Upvote 0
nad582 đã viết:
Chào a Hải và các a(c) trên GPE, e ứng dụng đoạn code trên vào bài tập của e như thế này:
Mã: 
Sub loc_gt()Application.ScreenUpdating = False
Dim r, Fr, n, mg4, mg5
r = 14
Do
   If n = 0 Then Fr = r
   If Cells(r, 3) = Cells(r + 1, 3) Then
      n = n + 1
   Else
      Set rng4 = Range(Cells(Fr, 15), Cells(r, 15)) 'cot O
      rng4.Find(Application.Max(rng4)).Offset(0, 0).Font.Bold = True
      rng4.Find(Application.Max(rng4)).Offset(0, -13).Font.ColorIndex = 1
      Set rng5 = Range(Cells(Fr, 16), Cells(r, 16)) 'cot P
      rng5.Find(Application.Max(rng5)).Offset(0, 0).Font.Bold = True
      rng5.Find(Application.Max(rng5)).Offset(0, -14).Font.ColorIndex = 1
      n = 0
   End If
   r = r + 1
Loop Until Cells(r, 3) = ""
Application.ScreenUpdating = True
End Sub
View attachment 128949
Giá trị cột O, ứng với tên cột C khi tìm giá trị max thì:
nếu như các giá trị max đó trùng nhau hết thì ko cần đánh dấu.
nếu các giá trị max không trùng nhau hết thì đánh dấu thằng đầu tiên.
Ví dụ như hình trên:
ở dòng 32 đến 40 tên cột C là 0,00 ứng với giá trị ở cột O là 0,50 hết vậy với code phía trên thì phải hiệu chỉnh thế nào ạ!!
xin các a(c) chỉ giúp e cảm ơn ! mong hồi âm!!
Nhấp chuột vào đây để mở rộng...

Với đề bài này chỉ bí phần MIN thôi còn max thì quá dễ mà sao lại phải code cho mệt vậy các bạn
Max đk abs ( của rang A1:A80) = if(-min(A1:A80)>max(A1:A80),min(A1:A80),MAX(A1:A80)) là xong dễ ợi
Còn min THÌ MÌNH ĂN CẮP CÔNG THỨC RẤT GỌN NHƯNG KHÔNG SỬA ĐƯỢC, CỨ KÍCH VÀO ĐỂ SỬA LÀ BÁO LỖI.
Bài đã được tự động gộp:

quangdungptc2 đã viết:
Với đề bài này chỉ bí phần MIN thôi còn max thì quá dễ mà sao lại phải code cho mệt vậy các bạn
Max đk abs ( của rang A1:A80) = if(-min(A1:A80)>max(A1:A80),min(A1:A80),MAX(A1:A80)) là xong dễ ợi
Còn min THÌ MÌNH ĂN CẮP CÔNG THỨC RẤT GỌN NHƯNG KHÔNG SỬA ĐƯỢC, CỨ KÍCH VÀO ĐỂ SỬA LÀ BÁO LỖI.
Nhấp chuột vào đây để mở rộng...

AI BIẾT CÔNG THỨC TÍNH MIN CHỈ MÌNH VỚI
Bài đã được tự động gộp:

nad582 đã viết:
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
Nhấp chuột vào đây để mở rộng...

OK: MAX thì dễ ợt ko cần code đâu, muốn max abs dãy bao nhiêu số cũng được: cứ trị tuyệt đối lớn nhất thì nó là max không cần biết nó âm hay dương:
VD: Dữ liệu ở cột B từ B2:B2000 nhé.
Max(B2:B2000) = if(-min(B2:B2000)>max(B2:B2000), min(B2:B2000), max(B2:B2000))
Còn muốn cho số âm mà có trị tuyệt đối lớn nhất đổi thành số dương luôn thì
Max(B2:B2000) = if(-min(B2:B2000)>max(B2:B2000), -min(B2:B2000), max(B2:B2000))

Mình chỉ bí phần MIN thôi. chỉ bí không hiểu công thức thôi còn ứng dụng mình vẫn xài được, chả cần code gì hết.
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

N
Nhờ giúp Drop down list theo tỉnh xã mới.
Trả lời
5
Đọc
167
ongke0711
ongke0711
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
435
Đọc
56K
truc.duong87
T
L
  • Question Question
Gõ và chọn tên trong ComboBox hiển thị giá trị trong textbox (1 người xem)
    • Cười
Trả lời
8
Đọc
343
ongke0711
ongke0711
H
Tự động cập nhật dữ liệu từ 2 file word
Trả lời
0
Đọc
23
hoangquochuy
H
E
VBA copy ô trong excel khi đang lọc filter (1 người xem)
Trả lời
3
Đọc
63
LOGANWover
L
befaint
[ Python và ứng dụng ] Công cụ trích xuất hàng loạt hóa đơn điện tử XML vào bảng Excel (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
56
Đọc
9K
Hoale85
H
Nam168
Không mở được file excel
Trả lời
2
Đọc
53
Nam168
Nam168
V
Quản lý xuất nhập vật tư trong kho (1 người xem)
Trả lời
14
Đọc
514
LOGANWover
L
phuongnam366377
Sử dụng COM DLL **không cần đăng ký** với Delphi 12 / C++ Builder
    • Thích
Trả lời
0
Đọc
66
phuongnam366377
phuongnam366377
N
Định mức nguyên vật liệu
Trả lời
49
Đọc
5K
ntan50
N
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột (1 người xem)
Trả lời
6
Đọc
280
Chả_biết_gì
C
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
26
Đọc
1K
haitien123
H
ongke0711
Truy cập trang GPE chậm
    • Thích
Trả lời
3
Đọc
186
Hai Lúa Miền Tây
Hai Lúa Miền Tây
V
Gộp File Từng File Excel vào 1 File (1 người xem)
Trả lời
16
Đọc
465
ptm0412
ptm0412
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
10
Đọc
784
Zizi One
Zizi One
I
Phân bổ số lượng xuất kho trong kỳ theo từng mã nguyên vật liệu
Trả lời
6
Đọc
200
IrisQ
I
L
Các bạn giúp mình hoàn thiện công thức hàm sumif nhé (2 người xem)
Trả lời
5
Đọc
162
lequang_qn
L
N
Xin file tính khẩu phần ăn cho trường mầm non
Trả lời
5
Đọc
6K
HUONGHCKT
H
Gà Công Nghệ
Cập nhật dữ liệu từ sheet này sang sheet khác (1 người xem)
Trả lời
14
Đọc
316
HUONGHCKT
H
queluatb
Tự động tăng số hóa đơn theo điều kiện
Trả lời
4
Đọc
177
queluatb
queluatb
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom