Tìm giá trị max của một array thõa điều kiện ràng buộc? (1 người xem)

ndu96081631 · 31/7/08

Chạy đua tốc độ đây:

PHP:

Option Explicit
Sub Loc()
    Dim DS As Range, Ma As Range, LocMa As Range
    Dim Temp As Range, Clls As Range
    Dim iR As Integer
    Application.ScreenUpdating = False
    Set DS = [A1].CurrentRegion
    DS.Sort Key1:=[A2], Order1:=1, Key2:=[B2], Order2:=2, Header:=1
    Set Ma = DS.Resize(DS.Rows.Count, 1)
    Range("F5:G1000").ClearContents
    Ma.AdvancedFilter Action:=2, CopyToRange:=[F4], Unique:=True
    Set Temp = [F4].CurrentRegion
    Set LocMa = Temp.Offset(1, 0).Resize(Temp.Rows.Count - 1, 1)
    LocMa.Sort Key1:=[F5], Order1:=1, Header:=0
    For Each Clls In LocMa
      iR = Application.WorksheetFunction.Match(Clls, Ma, 0)
      Clls.Offset(, 1) = [A1].Offset(iR - 1, 1)
    Next Clls
    Application.ScreenUpdating = True
End Sub

Tôi nghĩ code này sẽ rất nhanh! Dử liệu 10.000 dòng, lọc trong nháy mắt

ThuNghi · 31/7/08

ndu96081631 đã viết:
Chạy đua tốc độ đây:

Vậy thì không được rồi, làm biến đổi dữ liệu gốc. Nên có phần phụ để làm Loc.
Hình như match và ... khônh nhanh hơn Vlookup.

ndu96081631 · 31/7/08

ThuNghi đã viết:
Vậy thì không được rồi, làm biến đổi dữ liệu gốc. Nên có phần phụ để làm Loc.
Hình như match và ... khônh nhanh hơn Vlookup.

Đây chỉ là giãi thuật thôi! Nếu không muốn làm thay đổi dử liệu gốc thì thiếu gì cách: Copy sang 1 vùng tạm chẳng hạn!... Ngoài ra nếu vùng dử liệu có cột STT thì ta có thể lợi dụng cột này để sort dử liệu trả về lại từ đầu
MATCH theo kiểu này thì không biết có nhanh hơn VLOOKUP không nhưng nếu tôi dùng MATCH theo kiểu dò không chính xác thì chắc sẽ nhanh hơn nữa đấy (Vì theo tôi được biết hàm Match dò không chính xác, khi nó tìm được giá trị hợp lý là nó ra kết quả ngay chử không tìm hết cả vùng)

SA_DQ · 31/7/08

NDU à, để khỏi ảnh hưởng đến 2 cột 'A:B' gốc, với file dữ liệu của bạn ta phải chi trả 1 khoảng thời gian là:
0.1097585 - 0.075755 đó; mình làm thử rồi; Về tương đối mà nói, chiếm gần 1/2 thời gian đó !
Chỉ chưa thử với VLOOKUP() thôi; chứ thử theo cách MATCH() & phương thức tìm kiếm FIND() thì chúng tương đương với nhau về thời gian;
Góp ý nhỏ: Bạn nên xài lại các biến đối tượng, chứ không nên khai nhiều quá như vậy(!); Tiết kiệm là quốc sách mà!

PHP:

      Set DS = Ma.Find(Clls, lookat:=xlValue)
      If Not DS Is Nothing Then Clls.Offset(, 1) = DS.Offset(, 1)
'      iR = Application.WorksheetFunction.Match(Clls, Ma, 0)'
'      Clls.Offset(, 1) = [A1].Offset(iR - 1, 1)'

Nhưng quả thực thấy bạn tiến bộ trong VBA mà mính chóng cả mặt!
Nhất là CurentRegion & Resize! Mình hết vốn để khoe với mọi người rồi!
Khâm phục vô cùng!
Thôi nha; Hãy gọi mình là sư chính đi nha!

ndu96081631 · 31/7/08

Cảm ơn sư phụ!
Em vừa nghĩ ra thêm 2 cách nữa, anh nhận xét thế nào nhé
Cách 1: Dùng AutoFilter trên cột A theo điều kiện của từng cell trong cột F... Mổi lần Filter như vậy ta chọn vùng SpecialCells(xlCellTypeVisible) rồi lấy MAX của nó

PHP:

Option Explicit
Sub Loc()
    Dim DS As Range, Ma As Range, LocMa As Range
    Dim Temp As Range, Clls As Range, VDK As Range
    Application.ScreenUpdating = False
    Set DS = [A1].CurrentRegion
    Set Ma = DS.Resize(DS.Rows.Count, 1)
    Range("F5:G1000").ClearContents
    Ma.AdvancedFilter Action:=2, CopyToRange:=[F4], Unique:=True
    Set Temp = [F4].CurrentRegion
    Set LocMa = Temp.Offset(1, 0).Resize(Temp.Rows.Count - 1, 1)
    LocMa.Sort Key1:=[F5], Order1:=1, Header:=0
    For Each Clls In LocMa
        DS.AutoFilter Field:=1, Criteria1:=Clls.Value
        Set VDK = [A1].SpecialCells(xlCellTypeVisible)
        Clls.Offset(, 1) = Application.WorksheetFunction.Max(VDK)
    Next Clls
    DS.AutoFilter
    Application.ScreenUpdating = True
End Sub

Cách 2: Vẩn dùng các sort dử liệu, nhưng trứoc đó lưu nó vào vùng nhớ tạm, khi xong việc thì trả dử liệu về như củ:

PHP:

Option Explicit
Sub Loc()
    Dim DS As Range, Ma As Range, LocMa As Range
    Dim Temp As Range, Clls As Range
    Dim Luu As Variant
    Application.ScreenUpdating = False
    Set DS = [A1].CurrentRegion
    Luu = DS.Value
    DS.Sort Key1:=[A2], Order1:=1, Key2:=[B2], Order2:=2, Header:=1
    Set Ma = DS.Resize(DS.Rows.Count, 1)
    Range("F5:G1000").ClearContents
    Ma.AdvancedFilter Action:=2, CopyToRange:=[F4], Unique:=True
    Set Temp = [F4].CurrentRegion
    Set LocMa = Temp.Offset(1, 0).Resize(Temp.Rows.Count - 1, 1)
    LocMa.Sort Key1:=[F5], Order1:=1, Header:=0
    For Each Clls In LocMa
        Clls.Offset(, 1) = Application.WorksheetFunction.VLookup(Clls, DS, 2, 0)
    Next Clls
    DS.Value = Luu
    Application.ScreenUpdating = True
End Sub

Tiến bộ thêm chút nào đều nhờ có các sư phụ trên diển đàn chỉ vẽ!
Mong sư phụ Sa và các sư phụ khác hướng dẩn thêm để tối ưu hóa code
Chân thành cảm ơn!

Mr Okebab · 1/8/08

Cho em mượn File của bác NDU nhé

Thử 1 cái xem sao:

PHP:

Sub OB()
    Dim iR As Long, HC As Long, i As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    With Sheet1
        HC = .Range("A65000").End(xlUp).Row
        .Range("A1:A" & HC).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("I4"), Unique:=True
        iR = .Range("I65000").End(xlUp).Row
        For i = 5 To iR
            .Range("J" & i).FormulaArray = "=MAX(IF(R2C1:R" & HC & "C1=RC[-1],R2C2:R" & HC & "C2,0))"
        Next
        With .Range("J5:J" & iR)
                .Calculate
                .Value = .Value
        End With
        Call .Range("I4:J" & iR).Sort(.Range("I5"), xlAscending, , , , , , xlYes)
    End With
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Thân!

ngo15 · 1/8/08

Trình của các bạn quả là thâm hậu. Tôi mới đang nghiên cứu để hiểu hết các code trước mà đã lại có một loạt code mới.
To SA_DQ: Bạn cho hỏi code để biết thời gian thực hiện một macro?
Xin cám ơn.

ndu96081631 · 1/8/08

Lúc đầu tôi cũng định làm theo kiểu dùng thuộc tính FormulaArray nhưng không nghĩ ra được (còn non tay)
File này hay lắm!
(Còn thiếu chổ Clear vùng lọc)

SA_DQ · 1/8/08

Cách của mình theo kiểu "Nhà Nông" í mà!

ngo15 đã viết:
To SA_DQ: Bạn cho hỏi code để biết thời gian thực hiện một macro?

Ta mượn tạm Code của BAB vậy nha

PHP:

Sub OB()
    Dim iR As Long, HC As Long, i As Long
    Dim Timer_ As Double         '<<==| '
    
    Timer_ = Timer                '<<==| '
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    With Sheet1
        HC = .Range("A65000").End(xlUp).Row
        .Range("A1:A" & HC).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("I4"), Unique:=True
        iR = .Range("I65000").End(xlUp).Row
        For i = 5 To iR
            .Range("J" & i).FormulaArray = "=MAX(IF(R2C1:R" & HC & "C1=RC[-1],R2C2:R" & HC & "C2,0))"
        Next
        With .Range("J5:J" & iR)
                .Calculate
                .Value = .Value
        End With
        Call .Range("I4:J" & iR).Sort(.Range("I5"), xlAscending, , , , , , xlYes)
    End With
    MsgBox Timer - Timer_      '<<==| '
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

hoangdanh282vn · 2/8/08

Chạy đua về thời gian : với 65500 dòng mất 0.48s

PHP:

Sub Locmax2()
Dim i As Long
Dim tg As Double
    tg = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    Range("F2:G65536").Clear
    Range("A2:B" & [A65536].End(xlUp).Row).Copy Destination:=[I1]
    Range("I1:J" & [I65536].End(xlUp).Row).Sort Key1:=[I1], _
        Order1:=xlAscending, Key2:=[J1], Order2:=xlDescending
    Range("A1:A" & [A65536].End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=[F1], Unique:=True
    Range("F2:F" & [F65536].End(xlUp).Row).Sort Key1:=[F2], Order1:=xlAscending
    For i = 2 To [F65536].End(xlUp).Row
        Cells(i, 7).Value = Application.WorksheetFunction.Index(Range("J1:J" & [I65536].End(xlUp).Row), _
        Application.WorksheetFunction.Match(Cells(i, 6), Range("I1:I" & [I65536].End(xlUp).Row), 0), 1)
    Next
    Range("I1:J65536").Clear
    tg = Timer - tg
    MsgBox tg
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Mr Okebab · 2/8/08

hoangdanh282vn đã viết:

Chạy đua về thời gian : với 65500 dòng mất 0.48s

PHP:

Sub Locmax2()
Dim i As Long
Dim tg As Double
    tg = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    Range("F2:G65536").Clear
    Range("A2:B" & [A65536].End(xlUp).Row).Copy Destination:=[I1]
    Range("I1:J" & [I65536].End(xlUp).Row).Sort Key1:=[I1], _
        Order1:=xlAscending, Key2:=[J1], Order2:=xlDescending
    Range("A1:A" & [A65536].End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=[F1], Unique:=True
    Range("F2:F" & [F65536].End(xlUp).Row).Sort Key1:=[F2], Order1:=xlAscending
    For i = 2 To [F65536].End(xlUp).Row
        Cells(i, 7).Value = Application.WorksheetFunction.Index(Range("J1:J" & [I65536].End(xlUp).Row), _
        Application.WorksheetFunction.Match(Cells(i, 6), Range("I1:I" & [I65536].End(xlUp).Row), 0), 1)
    Next
    Range("I1:J65536").Clear
    tg = Timer - tg
    MsgBox tg
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Rất sáng tạo ở chỗ lợi dụng Sort Desceding ở cột giá trị, sau đó dùng Index + Match để lấy giá trị đầu tiên (lớn nhất).

Thân!

ndu96081631 · 2/8/08

hoangdanh282vn đã viết:
Chạy đua về thời gian : với 65500 dòng mất 0.48s

Bài này gần giống cách 2 ở bài #25 của tôi, nhưng:
1> Bạn copy dử liệu sang nơi khác sẽ mất thời gian hơn, và có thể đè lên dử liệu khác (trong trường hợp cột I có dử liệu)... Tôi thì không làm vậy, copy dử liệu vào vùng tạm
2> Dùng INDEX dài dòng hơn là VLOOKUP

Mr Okebab · 2/8/08

ndu96081631 đã viết:
Bài này gần giống cách 2 ở bài #25 của tôi, nhưng:
1> Bạn copy dử liệu sang nơi khác sẽ mất thời gian hơn, và có thể đè lên dử liệu khác (trong trường hợp cột I có dử liệu)... Tôi thì không làm vậy, copy dử liệu vào vùng tạm
2> Dùng INDEX dài dòng hơn là VLOOKUP

Đúng là 2 bài này có cách giải thuật giống nhau (sáng tạo)
Tuy nhiên :

- Bác NU dùng cách lưu giá trị cũ vào vùng nhớ tạm, sau khi xử lý xong sẽ cho nhận lại giá trị cũ : Điều này cũng tiện, nhưng để nói là nhanh hơn cách của hoangdanh thì không hẳn, bởi bác phải chiếm 1 vùng bộ nhớ khá lớn cho biến Luu, khi nhận ngược lại giá trị thì Excel cũng phải copy từng giá trị trong biến Luu vào từng Cell trong vùng.
Vì vậy, có nên chăng hoangdanh không copy nữa, mà nhận giá trị trực tiếp luôn :

PHP:

Range("I1:J" & [A65536].End(xlUp).Row-1).Value = _
       Range("A2:B" & [A65536].End(xlUp).Row).Value

Việc đè mất dữ liệu thì bác NU tối ưu hơn vì không làm mất dữ liệu, vì chỉ là 1 biến Luu thôi (tuy nhiên có thể làm mất công thức (nếu có)), Còn hoangdanh thì chắc chắn phải có 1 giải pháp dự phòng để không bị đè, đó là 1 vùng Temp được quy định sẵn, vì vậy ở mỗi phương pháp nên có 1 giải pháp dung hòa

- Index và Vlookup thì Vlookup sẽ viết gọn hơn, tuy nhiên lại không linh động như Index(match) được. Còn tốc độ thì có lẽ là như nhau.

Cách viết khác (tuy chẳng ngắn hơn)

PHP:

With WorksheetFunction
         Cells(i, 7).Value = .Index(Range("J1:J" & [I65536].End(xlUp).Row), _
            .Match(Cells(i, 6), Range("I1:I" & [I65536].End(xlUp).Row), 0), 1)
 End With

Ngoài ra, HoangDanh dùng rất nhiều [I65536].End(xlUp).Row) , đây là 1 con số đã đươc xác định, vì vậy nên cho nó vào 1 biến, VD như LastRow chẳng hạn, vừa gọn lại vừa nhanh hơn.

Thân!

ndu96081631 · 2/8/08

Mr Okebab đã viết:
Ngoài ra, HoangDanh dùng rất nhiều [I65536].End(xlUp).Row) , đây là 1 con số đã đươc xác định, vì vậy nên cho nó vào 1 biến, VD như LastRow chẳng hạn, vừa gọn lại vừa nhanh hơn.

Cảm ơn sư phụ đã nhận xét, tôi lại học thêm 1 chiêu nữa!
Việc dùng End(xlUp) cũng hay nhưng tôi thấy không tiện bằng Current Region và Resize (chiêu này học của sư phụ Sa)

Mr Okebab · 2/8/08

ndu96081631 đã viết:
Cảm ơn sư phụ đã nhận xét, tôi lại học thêm 1 chiêu nữa!
Việc dùng End(xlUp) cũng hay nhưng tôi thấy không tiện bằng Current Region và Resize (chiêu này học của sư phụ Sa)

Vâng, xác định vùng thì Current Region và Resize nhanh hơn và có vẻ tiện hơn, tuy nhiên End(xlUp) lại có thế mạnh riêng là xác định hàng rất tốt, phục vụ cho nhiều kiểu giải thuật.
Mà Resize cũng lại phải có số hàng, cho nên cũng tùy từng điều kiện ạ.
Cái này chắc bác SA và bác quá rành rồi.

Thân!

P/S : Đừng gọi em là sư phụ, giải thuật của em chưa bằng của bác đâu.

SA_DQ · 2/8/08

Cần giải pháp dung hòa?

Việc đè mất dữ liệu thì bác NU tối ưu hơn vì không làm mất dữ liệu, vì chỉ là 1 biến Luu thôi (tuy nhiên có thể làm mất công thức (nếu có)), Còn hoangdanh thì chắc chắn phải có 1 giải pháp dự phòng để không bị đè, đó là 1 vùng Temp được quy định sẵn, vì vậy ở mỗi phương pháp nên có 1 giải pháp dung hòa

Vố đầu chương trình thêm 8 cột mới trước cột 'A'
Nếu nó cự nự thì nghỉ chơi, tìm cách khác!
Nếu được thì cuối chương trình xóa bớt 6 cột, OK(?!)

ndu96081631 · 3/8/08

SA_DQ đã viết:
Vố đầu chương trình thêm 8 cột mới trước cột 'A'
Nếu nó cự nự thì nghỉ chơi, tìm cách khác!
Nếu được thì cuối chương trình xóa bớt 6 cột, OK(?!)

Lúc trước em cũng làm 1 code theo kiểu này:
1> Copy 2 cột A và B, paste theo kiểu Insert copy cells vào trước cột A
2> Thêm 1 cột rổng phía sau cột B để có thể dùng Current Region
3> Em sẽ xử lý dử liệu theo 2 cột mới này (hiện giờ nó cũng là A và B)
4> Làm xong thì xóa chúng đi
Làm thì OK nhưng em thấy không hay lắm nên không post lên (vì cãm giác tốc độ chậm hơn)

hoangdanh282vn · 4/8/08

With WorksheetFunction
Cells(i, 7).Value = .Index(Range("J1:J" & [I65536].End(xlUp).Row), _
.Match(Cells(i, 6), Range("I1:I" & [I65536].End(xlUp).Row), 0), 1)
End With

With WorksheetFunction <= Cái này quá hay, em không nghĩ là có thể dùng With được.
Còn :

Ngoài ra, HoangDanh dùng rất nhiều [I65536].End(xlUp).Row) , đây là 1 con số đã đươc xác định, vì vậy nên cho nó vào 1 biến, VD như LastRow chẳng hạn, vừa gọn lại vừa nhanh hơn.

Em cứ nghĩ là đưa nó vào biến thì sẽ chậm hơn là để nó tự nhiên, vì chưa có check lại nên em mới đưa nó ra như thế. Cám ơn anh vì điều này, sẽ còn học hỏi nhiều ở anh và mọi người.

ndu96081631 · 4/8/08

Chú ý thêm 1 chuyện nhỏ nữa:
[A65536].End(xlUp).Row sẽ có lúc cho kết quả sai khi dử liệu của bạn vừa vặn đến dòng 65536
Thử xem khi ấy kết quả [A65536].End(xlUp).Row có khi = 1 cũng không chừng

ngo15 · 4/8/08

Khi cột A không liên tục (Có dòng rỗng) CurrentRegion có vẻ không lấy tiếp được số liệu xuống dưới nữa.

Tìm giá trị max của một array thõa điều kiện ràng buộc? (1 người xem)

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

Huyền thoại GPE

File đính kèm

Hãy cho rồi sẽ nhận!

Huyền thoại GPE

/(hông là gì!

Huyền thoại GPE

File đính kèm

Ngon Ngất Ngây

File đính kèm

Thành viên chính thức

Huyền thoại GPE

/(hông là gì!

Nguyễn Cảnh Hoàng Danh

File đính kèm

Ngon Ngất Ngây

Huyền thoại GPE

Ngon Ngất Ngây

Huyền thoại GPE

Ngon Ngất Ngây

/(hông là gì!

Huyền thoại GPE

Nguyễn Cảnh Hoàng Danh

Huyền thoại GPE

Thành viên chính thức

Sinh nhật lần 19 GPE