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

ChanhTQ@ · 25/7/14

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

nad582 · 25/7/14

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

Ba Tê · 25/7/14

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

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]

hungpecc1 · 25/7/14

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

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

concogia · 25/7/14

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

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

nad582 · 25/7/14

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!!

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!!

hungpecc1 · 25/7/14

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

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

hungpecc1 · 25/7/14

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!!

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

nad582 · 26/7/14

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

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:

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!!

nad582 · 26/7/14

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

A concogia có thể giải quyết dùm e bài #7 luôn được ko? e cảm ơn!!

Quang_Hải · 26/7/14

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ả

hungpecc1 · 26/7/14

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!!

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
/.

phihndhsp · 26/7/14

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ả

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.

concogia · 26/7/14

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!!

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ả

Dữ liệu trong "Bài này" ra sao, bài này là.......bài nào ????
Híc

gtri · 26/7/14

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

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

hungpecc1 · 26/7/14

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.

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

Quang_Hải · 26/7/14

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.

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

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

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.

Quang_Hải · 26/7/14

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.

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.

hungpecc1 · 26/7/14

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.

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

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

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

File đính kèm

0901452không62

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

Cạo Rồi Khỏi Gội

Thành viên gắn bó

Gội rồi mới Cạo

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

File đính kèm

Thành viên gắn bó

Thành viên gắn bó

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

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

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

Thành viên gắn bó

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

Gội rồi mới Cạo

Thành viên tích cực

File đính kèm

Thành viên gắn bó

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

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

Thành viên gắn bó

Đếm ngược thời gian