Tăng tốc độ xử lý thiết lập độ cao dòng

[Vo Duy Minh]

Chào các bạn
Một lần nữa, rất mong nhận được sự hỗ trợ của các bạn với code VBA.
Tôi viết code để thiết lập độ cao (rowheight) của dòng theo giá trị của các cell liên quan trong dòng theo điều kiện nếu cell có giá trị 1 thì độ cao là 40, cell có giá trị 2 thì độ cao là 30, còn lại thì có độ cao là 10. Code như sau

Sub RowHeight()
Dim Cls As Range
For Each Cls In Range("D11000")
If Cls.Value = 1 Then
Cls.RowHeight = 40
ElseIf Cls.Value = 2 Then
Cls.RowHeight = 30
Else
Cls.RowHeight = 10
End If
Next
End Sub

Với code trên thì với file đơn giản thì chạy cũng ổn. Tuy nhiên khi đưa vào chương trình thực sự thì nó chạy chậm không tưởng (chắc cũng gần 5 phút).
Tôi rất mong nhận được sự hỗ trợ của các bạn để tốc độ xử lý của code có thể nhanh hơn.

Xin được cám ơn các bạn trước.
Tôi xin đính kèm file phòng ngừa yêu cầu của tôi trình bày không được rõ ràng.

 

[Hoàng Tuấn 868]

Chào các bạn
Một lần nữa, rất mong nhận được sự hỗ trợ của các bạn với code VBA.
Tôi viết code để thiết lập độ cao (rowheight) của dòng theo giá trị của các cell liên quan trong dòng theo điều kiện nếu cell có giá trị 1 thì độ cao là 40, cell có giá trị 2 thì độ cao là 30, còn lại thì có độ cao là 10. Code như sau

Sub RowHeight()
Dim Cls As Range
For Each Cls In Range("D11000")
If Cls.Value = 1 Then
Cls.RowHeight = 40
ElseIf Cls.Value = 2 Then
Cls.RowHeight = 30
Else
Cls.RowHeight = 10
End If
Next
End Sub

Với code trên thì với file đơn giản thì chạy cũng ổn. Tuy nhiên khi đưa vào chương trình thực sự thì nó chạy chậm không tưởng (chắc cũng gần 5 phút).
Tôi rất mong nhận được sự hỗ trợ của các bạn để tốc độ xử lý của code có thể nhanh hơn.

Xin được cám ơn các bạn trước.
Tôi xin đính kèm file phòng ngừa yêu cầu của tôi trình bày không được rõ ràng.

Anh thử cách không dùng vòng lặp xem sao.

 

[Vo Duy Minh]

Cám ơn bạn Hoàng Tuấn 868 đã gợi ý
Tôi đã giải quyết được vấn đề.
Có thể không pro lắm nhưng cũng ổn.

 

[Hoàng Tuấn 868]

Cám ơn bạn Hoàng Tuấn 868 đã gợi ý
Tôi đã giải quyết được vấn đề.
Có thể không pro lắm nhưng cũng ổn.

Em không biết cấu trúc dữ liệu thực của anh thế nào để thử anh ạ.

 

[Phuocam]

Cám ơn bạn Hoàng Tuấn 868 đã gợi ý
Tôi đã giải quyết được vấn đề.
Có thể không pro lắm nhưng cũng ổn.

Bạn có thể chia sẻ cách bạn đã giải quyết vấn đề?

 

[Vo Duy Minh]

Rất cám ơn anh đã quan tâm.
Tôi cũng hiểu nếu các bạn có đủ dữ liệu thì sẽ giải quyết ổn thoả hơn.
Nhưng đưa hết dữ liệu thì cũng rất nặng nên có phần bất tiện.
Dù sao thì tôi cũng giải quyết được vấn đề.
Một lần nữa, xin cám ơn anh rất nhiều.

 

[sangh]

Em tải thử file của bác chạy chưa được 2 giây đã xong rồi.

 

[SA_DQ]

Chủ bài viết đang đăng lộn tiệm
♥ ♦ ♣ ♠

 

[Hoàng Tuấn 868]

Chủ bài viết đang đăng lộn tiệm
♥ ♦ ♣ ♠

Đúng rồi anh, giờ em mới nhận ra.

 

[Vo Duy Minh]

Chào bạn sangh
Đúng là với file đó thì chỉ 2 giây là xong, nhưng đó là file không có dữ liệu.
Tôi cũng tưởng ok rồi, nhưng khi đưa vào chương trình thực thì nó chạy chậm không tưởng luôn.

Với bạn Phuocam
Thú thật với bạn thì cách xừ lý của tôi có phần thô thiển so với nhiều phương cách mà tôi học được từ các bạn.
Tôi áp dụng cách mà trước đây bạn batman1 giúp tôi (nhưng chỉ có 2 giá trị trong chuỗi thay vì 3) với 2 giá trị và sau đó Call cái Sub thiết lập rowheight cho giá trị thứ 3.
Anh có thể xem cách giải quyết của tôi trong file đính kèm với Sub ROWHEIGHT_1 (Sub ROWHEIGHT_2 là cho giá trị thứ 3)
Tốc độ xử lý trong chương trình của tôi thì khoảng chưa đến 5 giây nên cũng khả thi.

Tôi rất cám ơn các anh đã quan tâm.
Có thể từ cách giải quyết của tôi, các anh sẽ có hướng giải quyết còn đẹp và pro hơn rất nhiều.
Tôi cũng mong nhận được góp ý của các anh.

 

[Phuocam]

Tôi cũng mong nhận được góp ý của các anh.

Bạn thử chạy code sau:

Sub RowHeightV2()
Dim Cls As Range
Dim t As Double
Dim range1 As Range, range2 As Range
t = Timer
For Each Cls In Range("D1:D1000000")
If Cls.Value = 1 Then
    If range1 Is Nothing Then
        Set range1 = Cls
    Else
        Set range1 = Union(range1, Cls)
    End If
ElseIf Cls.Value = 2 Then
    If range2 Is Nothing Then
        Set range2 = Cls
    Else
        Set range2 = Union(range2, Cls)
    End If
End If
Next

Application.ScreenUpdating = False
    Range("D1:D1000000").RowHeight = 10
    range1.RowHeight = 40
    range2.RowHeight = 30   
Application.ScreenUpdating = True
MsgBox Timer - t
End Sub

Trên máy tôi, 1.000.000 dòng hết 2 giây.

 

[Maika8008]

Tôi nghĩ dùng phương thức Union để lấy 3 range theo điều kiện rồi chỉnh rowheight 1 lần là nhanh thôi nhỉ?

P/S: vừa enter là thấy bài của Phuocam, hì hì.

 

[Vo Duy Minh]

Cám ơn anh Phuocam rất nhiều
Rất tuyệt anh à.
Chỉ có một vấn đề nhỏ là đôi khi trong chuỗi không có giá trị 1 hoặc 2 (còn "" thì lúc nào cũng có), khi đó nó sẽ báo lỗi cho, chẳng hạn, range1.RowHeight = 40.
Tôi giải quyết bằng cách thêm giá trị đó cuối chuỗi vì thực ra tôi đâu cần đến 1 triệu dòng như thế, mà chỉ cần đến 4.000 dòng thôi.
Timer báo là 0.4516 giây.
Xin phép anh cho tôi bỏ cái timer đó ra khi áp dụng trong chương trình của tôi.
Một lần nữa, cám ơn anh rất nhiều.
Tôi không ngờ có thể nhận được sự hỗ trợ tuyệt vời đó từ các bạn.

 

[giaiphap]

Chỉ có một vấn đề nhỏ là đôi khi trong chuỗi không có giá trị 1 hoặc 2 (còn "" thì lúc nào cũng có), khi đó nó sẽ báo lỗi cho, chẳng hạn, range1.RowHeight = 40.

Sửa

range1.RowHeight = 40

thành

If Not range1 Is Nothing Then range1.RowHeight = 40

Làm tương tự cho range2

 

[Vo Duy Minh]

Cám ơn bạn "giaiphap"
Tôi đã thực hiện theo gợi ý của bạn.
Hiện nay thì code bạn Phuocam đề xuất thực sự rất tuyết vời.
Không chỉ lần này, đã có nhiều lần tôi nhận được sự hỗ trợ rất hữu ích của các bạn.
Rất cám ơn các bạn đã quan tâm.
Diễn đàn "giaiphapexcel" quả thật rất hữu ích, tôi vẫn thường tham khảo các bài viết của các bạn và đôi khi rút ra được những bài học hữu ích cho bản thân tôi.