So sánh Khoảng và đánh màu

[1986QV]

Bài toán viết code tô màu cho khoảng trắng max:
-Trường hợp 1: Max[1;1] sau khi so sánh giữa các [1;1] với nhau, đoạn nào có khoảng trắng lớn nhất thì tô màu cho [1;1] đó theo hàng ngang.
-Trường hợp 2: Max[1;0] sau khi chỉ so sánh giữa các [1;0] với nhau, đoạn nào có khoảng trắng lớn nhất thì tô màu cho [1;0] đó theo hàng ngang.
Em có gửi file ví dụ đính kèm mọi người coi và cho em ý kiến.
Xin Cảm ơn mọi người quan tâm và giúp đỡ!

 

[1986QV]

Các ae xem qua và viết em code cho 2 bài toán rời rạc này!
Thanks GPE!

 

[viehoai]

Bài toán viết code tô màu cho khoảng trắng max:
-Trường hợp 1: Max[1;1] sau khi so sánh giữa các [1;1] với nhau, đoạn nào có khoảng trắng lớn nhất thì tô màu cho [1;1] đó theo hàng ngang.
-Trường hợp 2: Max[1;0] sau khi chỉ so sánh giữa các [1;0] với nhau, đoạn nào có khoảng trắng lớn nhất thì tô màu cho [1;0] đó theo hàng ngang.
Em có gửi file ví dụ đính kèm mọi người coi và cho em ý kiến.
Xin Cảm ơn mọi người quan tâm và giúp đỡ!

Bạn test thử code sau nhé
[GPECODE=vb]Sub MaxBlank()
Dim Rng As Range, Rng1 As Range, Rng2 As Range, mRng As Range
Dim BlankCnt, MaxBln As Integer
For Each Rng In Sheet1.Range("a2:a4")
Set Rng1 = Rng.End(xlToRight)
Do
BlankCnt = Range(Rng1, Rng1.End(xlToRight)).Columns.Count - 2
If BlankCnt > MaxBln Then
MaxBln = BlankCnt
Set mRng = Rng1
End If
Set Rng1 = Rng1.End(xlToRight)
Loop Until Rng1.Column >= 31
Range(mRng.Offset(, 1), mRng.End(xlToRight).Offset(, -1)).Interior.ColorIndex = 6
Sheet1.Range("AE" & Rng.Row).Value = MaxBln
Set mRng = Nothing
Set Rng1 = Nothing
MaxBln = 0
Next
End Sub[/GPECODE]

 

[1986QV]

Thanks bác code 1 cho sheet1 chạy ok rồi bác còn code 2 Chạy khi chưa đúng Max ở cột Max[1;0] bác kiểm tra lại giúp em.
Thanks bác và GPE!

 

[viehoai]

Thanks bác code 1 cho sheet1 chạy ok rồi bác còn code 2 Chạy khi chưa đúng Max ở cột Max[1;0] bác kiểm tra lại giúp em.
Thanks bác và GPE!

Code sheet2 cũng vậy thôi, sữa lại tý thôi mà
[GPECODE=vb]Sub MaxBln10()
Dim Rng As Range, Rng1 As Range, Rng2 As Range, mRng As Range
Dim BlankCnt As Integer, MaxBln As Integer
On Error GoTo Tiep
For Each Rng In Sheet2.Range("a2:a6")
Set Rng1 = Rng.End(xlToRight)
MaxBln = 0
Do
If Rng1.Value = 1 And Rng1.End(xlToRight).Value = 0 Then
BlankCnt = Range(Rng1, Rng1.End(xlToRight)).Columns.Count - 2
If BlankCnt > MaxBln Then
MaxBln = BlankCnt
Set mRng = Rng1
End If
End If
Set Rng1 = Rng1.End(xlToRight)
Loop Until Rng1.Column >= 47
Range(mRng.Offset(, 1), mRng.End(xlToRight).Offset(, -1)).Interior.ColorIndex = 6
Sheet2.Range("AU" & Rng.Row).Value = MaxBln
Set mRng = Nothing
Set Rng1 = Nothing
Tiep:
Next
End Sub[/GPECODE]

 

[1986QV]

Cảm ơn bác rất nhiều, cảm ơn GPE. Bác cho em hỏi chút sao em thử 1 lần đầu ok, lần 2 thay đổi hoặc dịch chuyển 1 với sheet1, 0 với sheet2 thì màu lại tô từ cột AE đến cột bên phải AE max lấy từ 1 e làm 1 file vi dụ bác xem giúp em. hay có lỗi ở code chưa triệt để. Em hiểu lỗi rồi, do điểm cuối là 1. bác thử viết giúp em code mà ví dụ tại AE sheet 1 và AU sheet 2 là ô trống giờ cần hiện max.
Thanks bác, GPE!

 

[viehoai]

Cảm ơn bác rất nhiều, cảm ơn GPE. Bác cho em hỏi chút sao em thử 1 lần đầu ok, lần 2 thay đổi hoặc dịch chuyển 1 với sheet1, 0 với sheet2 thì màu lại tô từ cột AE đến cột bên phải AE max lấy từ 1 e làm 1 file vi dụ bác xem giúp em. hay có lỗi ở code chưa triệt để. Em hiểu lỗi rồi, do điểm cuối là 1. bác thử viết giúp em code mà ví dụ tại AE sheet 1 và AU sheet 2 là ô trống giờ cần hiện max.
Thanks bác, GPE!

Bạn sửa câu lệnh: Loop Until Rng1.Column >= 47
Thành: Loop Until Rng1.End(xlToRight).Column >= 47
Được không nhé

 

[1986QV]

Thanks bác đã chạy ok rồi. Cho em hỏi chút nếu em thêm phần phụ như sau bác xem chỉnh code giúp em được không.
đề sau: Em hỏi nếu tính được max rồi nếu tính tiếp khoảng trắng kề max sau đó thì code như thế nào các bác để hiện được cả 2 thông số như file ví dụ???.
Các bác xem qua và giúp em cái code chuẩn.
Cảm ơn bác và GPE !

 

[1986QV]

Các bác xem, code trên chỉnh như thế nào phù hợp với bài toán phụ không? hoặc có cách nào tô màu khoảng trắng tùy ý ví dụ muốn nó là 15, 16 hoặc là 8 khoảng cần được tô màu không các bác?
Thanks GPE!

 

[1986QV]

Bạn sửa câu lệnh: Loop Until Rng1.Column >= 47
Thành: Loop Until Rng1.End(xlToRight).Column >= 47
Được không nhé

Chào thầy!
lâu lâu em đọc lại bài này, thấy hay hay rồi và tốc đọ xử lý bài toán rất ok. Em muốn nhờ thầy chỉnh sửa code cùng nội dung ấy cho phù hợp với bài toán như vầy.
Bài toán viết code tô màu cho khoảng trắng max:
-Trường hợp 1: Max[1;1] sau khi so sánh giữa các [1;1] với nhau, đoạn nào có khoảng trắng lớn nhất thì tô màu cho [1;1] đó theo hàng ngang. Tính khoáng trắng sau Max[1;1] và tính khoảng trắng cuối cùng từ 1
-Trường hợp 2: Max[1;0] sau khi chỉ so sánh giữa các [1;0] với nhau, đoạn nào có khoảng trắng lớn nhất thì tô màu cho [1;0] đó theo hàng ngang. Tính khoáng trắng sau Max[1;0] và tính khoảng trắng cuối cùng từ 1.
Tiện em gửi thầy file để tiện theo dõi.
Cảm ơn thầy nhiều. Chúc thầy nhiều sức khỏe!

 

[1986QV]

Chào thầy!
lâu lâu em đọc lại bài này, thấy hay hay rồi và tốc đọ xử lý bài toán rất ok. Em muốn nhờ thầy chỉnh sửa code cùng nội dung ấy cho phù hợp với bài toán như vầy.
Bài toán viết code tô màu cho khoảng trắng max:
-Trường hợp 1: Max[1;1] sau khi so sánh giữa các [1;1] với nhau, đoạn nào có khoảng trắng lớn nhất thì tô màu cho [1;1] đó theo hàng ngang. Tính khoáng trắng sau Max[1;1] và tính khoảng trắng cuối cùng từ 1
-Trường hợp 2: Max[1;0] sau khi chỉ so sánh giữa các [1;0] với nhau, đoạn nào có khoảng trắng lớn nhất thì tô màu cho [1;0] đó theo hàng ngang. Tính khoáng trắng sau Max[1;0] và tính khoảng trắng cuối cùng từ 1.
Tiện em gửi thầy file để tiện theo dõi.
Cảm ơn thầy nhiều. Chúc thầy nhiều sức khỏe!

Thầy Hoài chắc bận, vậy các thầy các bạn nào đọc rồi có thể giúp mình được không? Xin cảm ơn GPE!