Tìm khoảng maxblank cho hàng trên VBA (1 người xem)

[DanTri007]

Bài toán tìm khoảng maxblank dựa vào code VBA
B1: Tính max khoảng trống trong [3;A] (A có thể là 3 hoặc 2, hoặc 1) tìm các khoảng max trong [3;A], sau đó so sánh các khoảng max lấy giá trị khoảng max lớn nhất. khi điểm gốc tại 3 và cơ sở tính theo hàng và tính khoảng trống cuối cùng từ 3 khi chưa có điểm A nào, Sau đó đưa vào bảng đánh giá bên. Như file ví dụ em gửi tại sheet1.
B2: Tương tự ta B1: Tính max khoảng trống trong [2;A] (A có thể là 2, hoặc 1) tìm các khoảng max trong [2;A], sau đó so sánh các khoảng max lấy giá trị khoảng max lớn nhất. khi điểm gốc tại 2 và cơ sở tính theo hàng và tính khoảng trống cuối cùng từ 2 khi chưa có điểm A nào, Sau đó đưa vào bảng đánh giá bên. Như file ví dụ em gửi tại sheet2.
Thanks GPE!

 

[dhn46]

Bạn dùng thử cái này nhé

Sub Max3A()
    Dim Arr, Res
    Dim i As Long, j As Long, t As Long, Count3A As Long, CountBlk As Long, UCL As Long
    Arr = Range("B5:BA" & Range("A65536").End(3).Row)
    UCL = UBound(Arr, 2)
    ReDim Res(1 To UBound(Arr, 1), 1 To 2)
    For i = 1 To UBound(Arr, 1)
        For j = 1 To UCL
            If Arr(i, j) = 3 Then
                Count3A = 0
                For t = j + 1 To UCL
                    If Arr(i, t) = "" Then
                        Count3A = Count3A + 1
                    Else
                        If Res(i, 1) < Count3A Then
                            Res(i, 1) = Count3A
                        End If
                        j = t
                        Exit For
                    End If
                Next
            End If
            CountBlk = 0
            For t = UCL To 1 Step -1
                If Arr(i, t) = "" Then
                    CountBlk = CountBlk + 1
                ElseIf Arr(i, t) = 3 Then
                    Res(i, 2) = CountBlk
                    Exit For
                ElseIf Arr(i, t) <> "" Then
                    Exit For
                End If
            Next
        Next
    Next
    Range("BD5").Resize(UBound(Arr, 1), 2) = Res
End Sub

 

[SA_DQ]

Phải nói rằng khá khen cho chàng này, hiểu được mí đồ tác giả!

Mình thì thua đến thua!

 

[DanTri007]

bác thể coi lại k? e thấy bác lỗi 1004. Anh em GPE qua xem trợ giúp em chút.
Thanks GPE!

 

[DanTri007]

thanks GPE! em đã làm lại và chạy ổn định thanks tác dhn46 rất nhiều

 

[dhn46]

Phải nói rằng khá khen cho chàng này, hiểu được mí đồ tác giả!

Mình thì thua đến thua!

Dạ, dhn46 thấy dạng bài này giống với trường hợp của 2 bạn trên diễn đàn đã hỏi trước kia (dhn46 không nhớ rõ tên nữa) nên làm đại bác ạ.

Dhn46 cũng bắt đầu từ những bài căn bản của bác, đó là cái gốc để phát triển rất hay và dễ hiểu. Spam một chút chứ Dhn46 thấy ai mà bắt đầu tìm hiểu VBA thì nên đọc kỹ những bài viết của bác trước rồi hãy đi tiếp.

Cảm ơn bác nhiều!

 

[DanTri007]

Bác cho em hỏi sau khi tính max và so sánh khoảng [3:A] (A có thể là 1,2,3,4,5) với nhau rồi. tính Khoảng maxblank sau A (A<=>A) mà ta tìm được và so sánh khoảng maxblank [3:A] lớn nhất đó. em gửi file ví dụ theo kèm mọi người coi giúp em!
Thanks GPE!!!

 

[dhn46]

Bác cho em hỏi sau khi tính max và so sánh khoảng [3:A] (A có thể là 1,2,3,4,5) với nhau rồi. tính Khoảng maxblank sau A (A<=>A) mà ta tìm được và so sánh khoảng maxblank [3:A] lớn nhất đó. em gửi file ví dụ theo kèm mọi người coi giúp em!
Thanks GPE!!!

Không biết do tôi hiểu sai hay do ví dụ của bạn chưa chuẩn cho trường hợp sau A.
Ví dụ: K5 theo tôi phải là 0 thì của bạn là 2. Tương tự như K10, K15.

Bạn dùng Code sau cho cách hiểu của tôi:

Sub Max3A()
    Dim Arr, Res
    Dim i As Long, j As Long, t As Long, Count3A As Long, CountAA As Long, CountBlk As Long, UCL As Long, CountBlkAfterA As Long
    Arr = Range("B7:Z" & Range("A65536").End(3).Row)
    UCL = UBound(Arr, 2)
    ReDim Res(1 To UBound(Arr, 1), 1 To 4)
    For i = 1 To UBound(Arr, 1)
        For j = 1 To UCL
            '===================
            If Arr(i, j) = 3 Then
                Count3A = 0
                For t = j + 1 To UCL
                    If Arr(i, t) = "" Then
                        Count3A = Count3A + 1
                    Else
                        If Res(i, 1) < Count3A Then
                            Res(i, 1) = Count3A
                        End If
                        j = t
                        Exit For
                    End If
                Next
            End If
            '====================
            If Arr(i, j) <> 3 And Arr(i, j) <> "" Then
                CountAA = 0
                For t = j + 1 To UCL
                    If Arr(i, t) = "" Then
                        CountAA = CountAA + 1
                    ElseIf Arr(i, t) <> 3 And Arr(i, t) <> "" Then
                        If Res(i, 3) < CountAA Then
                            Res(i, 3) = CountAA
                        End If
                        j = t
                        Exit For
                    Else: Exit For
                    End If
                    If Res(i, 3) < CountAA Then
                        Res(i, 3) = CountAA
                    End If
                Next
            End If
            '===================
            CountBlk = 0
            CountBlkAfterA = 0
            For t = UCL To 1 Step -1
                If Arr(i, t) = "" Then
                    CountBlk = CountBlk + 1
                    CountBlkAfterA = CountBlkAfterA + 1
                ElseIf Arr(i, t) = 3 Then
                    Res(i, 2) = CountBlk
                    Exit For
                ElseIf Arr(i, t) <> "" Then
                    Res(i, 4) = CountBlkAfterA
                    Exit For
                End If
            Next
        Next
    Next
    Range("AA7").Resize(UBound(Arr, 1), 4) = Res
End Sub

 

[DanTri007]

Bác có thể xem bài em gửi qua mail đó. Có thể cấu trúc bài thay đổi chút ít. Rất cảm ơn bác giúp đỡ!
Cảm ơn GPE!

 

[dhn46]

Bác có thể xem bài em gửi qua mail đó. Có thể cấu trúc bài thay đổi chút ít. Rất cảm ơn bác giúp đỡ!
Cảm ơn GPE!

1/ Bạn xác nhận câu hỏi tại bài #8, và tính chính xác của Code bào #8

2/ Tôi đã check mail và thấy cấu trúc chả có gì khác cả. Tốt nhất bạn nên post lên đây để mọi người cùng chia sẻ trừ những dữ liệu quá riêng tư thôi.

3/ Trong File bạn mail cho tôi có thấy A, B để thay cho những con số. Bạn lưu ý rằng với những Code đã viết thì cái mốc để thực hiện đó là số 3. Vậy nó chỉ đúng với một mốc nhất định, và nếu bạn biết chỉnh code thì bạn hãy chuyển những cái gì như "= 3", "<> 3" bằng cái mốc của bạn.

4/ Nếu bạn biết ít nhiều về VBA thì việc chỉnh sửa Code sẽ đơn giản nếu không thì cấu trúc thay đổi đồng nghĩa với Code thay đổi bạn không chỉnh được, 3 bài hỏi của bạn cũng có sự khác nhau nên tôi nghĩ bạn nên đưa ra file chuẩn nhất để làm rồi mầy mò học sửa code sau bạn nhỉ?

Chúc bạn thành công!

 

[DanTri007]

Rất cảm ơn bác góp ý. Bài đó là có chút thay đổi nên phải nhờ bác, các bài khác em đã post để tham khảo mọi người rồi bác. file chuẩn nhất là bài đầu. file em gửi là file em tìm hiểu mong bác giúp. Cảm ơn bác!
Cảm ơn GPE!

 

[DanTri007]

View attachment 125386Bài #8 Bác xem cần code cần chỉnh lại ở đây max [A:A] là đoạn sau khi so sánh maxblanks [3:A] lấy max rồi.Đoạn [A:A] liền kề sau maxblank đó Điểm A đó là thuộc điểm đến từ 3. Em gửi kèm file.
Cảm ơn bác!

 

[DanTri007]

Bác check lại file nha!

 

[dhn46]

Thế còn trường hợp như thế này thì sao bạn: 3-----2---3---4

 

[DanTri007]

Bác hỏi đúng ý như vầy k? Trường hợp K4

 

[DanTri007]

Có vẻ bác hiểu nhầm ở điểm đó(3..3...3 hoặc 3..3...4 max[3:A] là 3 bác lấy 3 làm gốc còn A có thể 1 or 2,3,4,5 tùy ý. nên chạy code nhiều phần bị nhầm ở đó. bác coi kỹ giúp em. Cảm ơn bác Dhn46!

 

[dhn46]

Bạn test Code sau

Sub Max3A()
    Dim Arr, Res
    Dim i As Long, j As Long, t As Long, Count3A As Long, CountAA As Long, CountBlk As Long, UCL As Long, CountBlkAfterA As Long, Tmp As Long
    Arr = Range("B7:Z" & Range("A65536").End(3).Row)
    UCL = UBound(Arr, 2)
    ReDim Res(1 To UBound(Arr, 1), 1 To 4)
    For i = 1 To UBound(Arr, 1)
        For j = 1 To UCL
            '===================
            If Arr(i, j) = 3 Then
                Count3A = 0
                For t = j + 1 To UCL
                    If Arr(i, t) = "" Then
                        Count3A = Count3A + 1
                    Else
                        If Res(i, 1) < Count3A Then
                            Res(i, 1) = Count3A
                            Tmp = j + Count3A + 2
                        End If
                        j = t
                        Exit For
                    End If
                Next
            End If
            '====================
            For t = Tmp To UCL
                If Arr(i, t) = "" Then
                    CountAA = CountAA + 1
                Else
                    Res(i, 3) = CountAA
                    CountAA = 0
                    Exit For
                End If
            Next
            '===================
            CountBlk = 0
            CountBlkAfterA = 0
            For t = UCL To 1 Step -1
                If Arr(i, t) = "" Then
                    CountBlk = CountBlk + 1
                    CountBlkAfterA = CountBlkAfterA + 1
                ElseIf Arr(i, t) = 3 Then
                    Res(i, 2) = CountBlk
                    Exit For
                ElseIf Arr(i, t) <> "" Then
                    Res(i, 4) = CountBlkAfterA
                    Exit For
                End If
            Next
        Next
    Next
    Range("AA7").Resize(UBound(Arr, 1), 4) = Res
End Sub

 

[DanTri007]

Cảm ơn bác đã bớt time giúp em!
Bác xem lại coi toàn báo lỗi run-time error'9'. có lẽ em phải gửi file này bác coi xem bị lỗi ở đâu.

 

[dhn46]

Lỗi là do dòng của bạn không có giá trị 3 nào. Bạn sửa một chút đoạn, phần đỏ là thêm vào

            '====================
[COLOR=#ff0000]            If Tmp Then[/COLOR]
                For t = Tmp To UCL
                    If Arr(i, t) = "" Then
                        CountAA = CountAA + 1
                    Else
                        Res(i, 3) = CountAA
                        CountAA = 0
                        Exit For
                    End If
                Next
[COLOR=#ff0000]            End If[/COLOR]
            '===================

 

[DanTri007]

OK MEN.Thanks bác nhiều. Nhưng có vài điều không hiểu code chạy bi nhầm bác coi lại em gửi file đã so sánh và lỗi sai chỉ ra.
maxblank [3:A] phải so sánh với [3;3] nữa với cho ra maxblanks[3;A] vì A có thể là 1 or 2,or 3,or 4 mà bác.
lỗi ở đây là chưa so sánh với [3;3].
Bác chỉnh giúp em code chuẩn nhất.

 

[DanTri007]

Các bác và bác dhn46 vào coi giúp em xem lỗi ở đâu chỉ giáo dùm em.
Trân trọng và cảm ơn!

 

[DanTri007]

lỗi code chỗ nào GPE ơi?...

 

[dhn46]

Code thì không lỗi, cái lỗi ở đây là việc hiểu ý của bạn thôi, khá rối rắm và phức tạp, ngay cả file bạn post tại bài #20 cũng thế

Với yêu cầu của bạn thì

- Dòng 7 đếm bằng tay Max 3A là 18 trong khi file của bạn là 19
- Dòng 22 đếm bằng tay Max 3A là 15 trong khi file của bạn là 16

Thôi kệ cứ theo cái bằng tay nha.

Sub Max3A()
    Dim Arr, Res
    Dim i As Long, j As Long, t As Long, Count3A As Long, CountAA As Long, CountBlk As Long, UCL As Long, CountBlkAfterA As Long, Tmp As Long
    Arr = Range("B3:EBL" & Range("A65536").End(3).Row)
    UCL = UBound(Arr, 2)
    ReDim Res(1 To UBound(Arr, 1), 1 To 4)
    For i = 1 To UBound(Arr, 1)
        For j = 1 To UCL
            '===================
            If Arr(i, j) = 3 Then
                Count3A = 0
                For t = j + 1 To UCL
                    If Arr(i, t) = "" Then
                        Count3A = Count3A + 1
                    ElseIf Arr(i, t) = 3 Then
                        Count3A = 0
                    Else
                        If Res(i, 1) < Count3A Then
                            Res(i, 1) = Count3A
                            Tmp = j + Count3A + 2
                        End If
                        j = t
                        Exit For
                    End If
                Next
            End If
            '====================
            If Tmp Then
                For t = Tmp To UCL
                    If Arr(i, t) = "" Then
                        CountAA = CountAA + 1
                    Else
                        Res(i, 3) = CountAA
                        CountAA = 0
                        Exit For
                    End If
                Next
            End If
            '===================
            CountBlk = 0
            CountBlkAfterA = 0
            For t = UCL To 1 Step -1
                If Arr(i, t) = "" Then
                    CountBlk = CountBlk + 1
                    CountBlkAfterA = CountBlkAfterA + 1
                ElseIf Arr(i, t) = 3 Then
                    Res(i, 2) = CountBlk
                    Exit For
                ElseIf Arr(i, t) <> "" Then
                    Res(i, 4) = CountBlkAfterA
                    Exit For
                End If
            Next
        Next
    Next
    Range("EBP3").Resize(UBound(Arr, 1), 4) = Res
End Sub

 

[DanTri007]

1/ Bạn xác nhận câu hỏi tại bài #8, và tính chính xác của Code bào #8

2/ Tôi đã check mail và thấy cấu trúc chả có gì khác cả. Tốt nhất bạn nên post lên đây để mọi người cùng chia sẻ trừ những dữ liệu quá riêng tư thôi.

3/ Trong File bạn mail cho tôi có thấy A, B để thay cho những con số. Bạn lưu ý rằng với những Code đã viết thì cái mốc để thực hiện đó là số 3. Vậy nó chỉ đúng với một mốc nhất định, và nếu bạn biết chỉnh code thì bạn hãy chuyển những cái gì như "= 3", "<> 3" bằng cái mốc của bạn.

4/ Nếu bạn biết ít nhiều về VBA thì việc chỉnh sửa Code sẽ đơn giản nếu không thì cấu trúc thay đổi đồng nghĩa với Code thay đổi bạn không chỉnh được, 3 bài hỏi của bạn cũng có sự khác nhau nên tôi nghĩ bạn nên đưa ra file chuẩn nhất để làm rồi mầy mò học sửa code sau bạn nhỉ?

Chúc bạn thành công!

Bác dhn46 ah! em có thay đổi đến khi chạy thì lỗi code khi áp dụng nó bằng 1 và trường hợp 2 bác xem thế nào? chỉnh phù code phù với 2 file em gửi đây
Trường hợp 2: như [1;0] (chỉ so sánh và lấy max cho những đoạn[1;0] với nhau và lấy sau max[1;0] đến 0, hoặc 1 như file ví dụ bác ah!).

 

[DanTri007]

Bác dhn46 ah! em có thay đổi đến khi chạy thì lỗi code khi áp dụng nó bằng 1 và trường hợp 2 bác xem thế nào? chỉnh phù code phù với 2 file em gửi đây
Trường hợp 2: như [1;0] (chỉ so sánh và lấy max cho những đoạn[1;0] với nhau và lấy sau max[1;0] đến 0, hoặc 1 như file ví dụ bác ah!).

file cho trường hợp 2

 

[dhn46]

Bạn Post cái Code + file của bạn lên đây nhé. Sau 1 khoảng thời gian dài là quên hết không nhớ mình đã viết gì đâu.

 

[DanTri007]

Bạn Post cái Code + file của bạn lên đây nhé. Sau 1 khoảng thời gian dài là quên hết không nhớ mình đã viết gì đâu.

Em đã thử nghiệm bác coi qua:
Bác dhn46 ah! em có thay đổi đến khi chạy thì lỗi code khi áp dụng nó bằng 1 và trường hợp 2 bác xem thế nào? chỉnh phù code phù với 2 file em gửi đây
Trường hợp 2: như [1;0] (chỉ so sánh và lấy max cho những đoạn[1;0] với nhau và lấy sau max[1;0] đến 0, hoặc 1 như file ví dụ bác ah!).
Hiện tại không tải được file lên em gửi links bác coi tải xuống giúp em.

https://www.mediafire.com/?fd83k8b38c4ja8g

 

[dhn46]

Code không sai mà cái sai là chính bạn không biết mình đang yêu cầu + hỏi cái gì trong quá khứ.

Quá khứ: yêu cầu tìm Max 3A
Hiện tại : áp dụng cho Max 33

Bạn dùng cái sau, sửa cái NumConst cho số 1,2,3...

Sub Max3A()
    Dim Arr, Res
    Dim i As Long, j As Long, t As Long, Count3A As Long, CountAA As Long, CountBlk As Long, UCL As Long, CountBlkAfterA As Long, Tmp As Long
    Dim NumConst As Long, Count33 As Long
    NumConst = 1
    Arr = Range("B3:ECQ" & Range("A65536").End(3).Row)
    UCL = UBound(Arr, 2)
    ReDim Res(1 To UBound(Arr, 1), 1 To 5)
    For i = 1 To UBound(Arr, 1)
        For j = 1 To UCL
            '3A===================
            If Arr(i, j) = NumConst Then
                Count3A = 0
                Count33 = 0
                For t = j + 1 To UCL
                    If Arr(i, t) = "" Then
                        Count3A = Count3A + 1
                        Count33 = Count33 + 1
                    ElseIf Arr(i, t) = NumConst Then
                        'Count33----
                        If Res(i, 5) < Count33 Then
                            Res(i, 5) = Count33
                        End If
                        j = t - 1
                        Exit For
                    Else
                        If Res(i, 1) < Count3A Then
                            Res(i, 1) = Count3A
                            Tmp = j + Count3A + 2
                        End If
                        j = t - 1
                        Exit For
                    End If
                Next
            End If
            'AA after 3A ========
            If Tmp Then
                For t = Tmp To UCL
                    If Arr(i, t) = "" Then
                        CountAA = CountAA + 1
                    Else
                        Res(i, 3) = CountAA
                        CountAA = 0
                        Exit For
                    End If
                Next
            End If
            'Blank=====================
            CountBlk = 0
            CountBlkAfterA = 0
            For t = UCL To 1 Step -1
                If Arr(i, t) = "" Then
                    CountBlk = CountBlk + 1
                    CountBlkAfterA = CountBlkAfterA + 1
                ElseIf Arr(i, t) = NumConst Then
                    Res(i, 2) = CountBlk
                    Exit For
                ElseIf Arr(i, t) <> "" Then
                    Res(i, 4) = CountBlkAfterA
                    Exit For
                End If
            Next
            '33==========================
        Next
    Next
    Range("ECV3").Resize(UBound(Arr, 1), 5) = Res
End Sub

 

[DanTri007]

Code không sai mà cái sai là chính bạn không biết mình đang yêu cầu + hỏi cái gì trong quá khứ.

Quá khứ: yêu cầu tìm Max 3A
Hiện tại : áp dụng cho Max 33

Bạn dùng cái sau, sửa cái NumConst cho số 1,2,3...

Sub Max3A()
    Dim Arr, Res
    Dim i As Long, j As Long, t As Long, Count3A As Long, CountAA As Long, CountBlk As Long, UCL As Long, CountBlkAfterA As Long, Tmp As Long
    Dim NumConst As Long, Count33 As Long
    NumConst = 1
    Arr = Range("B3:ECQ" & Range("A65536").End(3).Row)
    UCL = UBound(Arr, 2)
    ReDim Res(1 To UBound(Arr, 1), 1 To 5)
    For i = 1 To UBound(Arr, 1)
        For j = 1 To UCL
            '3A===================
            If Arr(i, j) = NumConst Then
                Count3A = 0
                Count33 = 0
                For t = j + 1 To UCL
                    If Arr(i, t) = "" Then
                        Count3A = Count3A + 1
                        Count33 = Count33 + 1
                    ElseIf Arr(i, t) = NumConst Then
                        'Count33----
                        If Res(i, 5) < Count33 Then
                            Res(i, 5) = Count33
                        End If
                        j = t - 1
                        Exit For
                    Else
                        If Res(i, 1) < Count3A Then
                            Res(i, 1) = Count3A
                            Tmp = j + Count3A + 2
                        End If
                        j = t - 1
                        Exit For
                    End If
                Next
            End If
            'AA after 3A ========
            If Tmp Then
                For t = Tmp To UCL
                    If Arr(i, t) = "" Then
                        CountAA = CountAA + 1
                    Else
                        Res(i, 3) = CountAA
                        CountAA = 0
                        Exit For
                    End If
                Next
            End If
            'Blank=====================
            CountBlk = 0
            CountBlkAfterA = 0
            For t = UCL To 1 Step -1
                If Arr(i, t) = "" Then
                    CountBlk = CountBlk + 1
                    CountBlkAfterA = CountBlkAfterA + 1
                ElseIf Arr(i, t) = NumConst Then
                    Res(i, 2) = CountBlk
                    Exit For
                ElseIf Arr(i, t) <> "" Then
                    Res(i, 4) = CountBlkAfterA
                    Exit For
                End If
            Next
            '33==========================
        Next
    Next
    Range("ECV3").Resize(UBound(Arr, 1), 5) = Res
End Sub

Bác xem lại trường hợp này chưa? sao em chạy mà vẫn chưa chuẩn:

https://www.mediafire.com/?4lq9e392fhb3mbs

Thiếu phần này nữa:KHOẢNG SAU MAX [1;1] đến 1 [1;1]=>1
bác kiểm tra lại giúp em.

 

[dhn46]

Bác xem lại trường hợp này chưa? sao em chạy mà vẫn chưa chuẩn:

https://www.mediafire.com/?4lq9e392fhb3mbs

Thiếu phần này nữa:KHOẢNG SAU MAX [1;1] đến 1 [1;1]=>1
bác kiểm tra lại giúp em.

- Với file yêu cầu lần 1: khoảng sau max là [3-A] Code trả về kết quả đúng.
-Với file yêu cầu lần này khác hoàn toàn sau max [1:1] nên sai khác là tất nhiên. Không biết bạn có nhận ra sự khác nhau giữa 2 yêu cầu không?

Lúc nào thật rảnh tôi sẽ sửa cho bạn.

 

[DanTri007]

- Với file yêu cầu lần 1: khoảng sau max là [3-A] Code trả về kết quả đúng.
-Với file yêu cầu lần này khác hoàn toàn sau max [1:1] nên sai khác là tất nhiên. Không biết bạn có nhận ra sự khác nhau giữa 2 yêu cầu không?

Lúc nào thật rảnh tôi sẽ sửa cho bạn.

Vâng, đúng là có khác. Thanks bác vậy.

 

[dhn46]

Bạn xem vầy có được không?

Sub Max3A()
    Dim Arr, Res
    Dim i As Long, j As Long, t As Long, Count3A As Long, CountAA As Long, CountBlk As Long, UCL As Long, CountBlkAfterA As Long, Tmp As Long
    Dim NumConst As Long, Count33 As Long
    NumConst = 1
    Arr = Range("B3:ECQ" & Range("A65536").End(3).Row)
    UCL = UBound(Arr, 2)
    ReDim Res(1 To UBound(Arr, 1), 1 To 5)
    For i = 1 To UBound(Arr, 1)
        For j = 1 To UCL
            '3A===================
            If Arr(i, j) = NumConst Then
                Count3A = 0
                Count33 = 0
                For t = j + 1 To UCL
                    If Arr(i, t) = "" Then
                        Count3A = Count3A + 1
                        Count33 = Count33 + 1
                    ElseIf Arr(i, t) = NumConst Then
                        'Count33----
                        If Res(i, 5) < Count33 Then
                            Res(i, 5) = Count33
                            Tmp = j + Count3A + 2
                        End If
                        j = t - 1
                        Exit For
                    End If
                Next
            End If
            'AA after 33 ========
            If Tmp Then
                For t = Tmp To UCL
                    If Arr(i, t) = "" Then
                        CountAA = CountAA + 1
                    Else
                        Res(i, 3) = CountAA
                        CountAA = 0
                        Exit For
                    End If
                Next
            End If
            'Blank=====================
            CountBlk = 0
            CountBlkAfterA = 0
            For t = UCL To 1 Step -1
                If Arr(i, t) = "" Then
                    CountBlk = CountBlk + 1
                    CountBlkAfterA = CountBlkAfterA + 1
                ElseIf Arr(i, t) = NumConst Then
                    Res(i, 2) = CountBlk
                    Exit For
                ElseIf Arr(i, t) <> "" Then
                    Res(i, 4) = CountBlkAfterA
                    Exit For
                End If
            Next
            '33==========================
        Next
    Next
    Range("ECV3").Resize(UBound(Arr, 1), 5) = Res
End Sub

 

[DanTri007]

Bác ah! em chạy với 3 ok, 2 chết luôn, max [2;A] sai và bị lỗi khi tính sau max[2;A] đến A. Còn với 1 tính max[1;A] sai, và bị lỗi khi tính sau max[1;A] đến A. (A có thể là 1, or 2, or 3, or 4). có lẽ sai này có chung 1 điểm.
bác coi lại giúp em.

 

[dhn46]

Bác ah! em chạy với 3 ok, 2 chết luôn, max [2;A] sai và bị lỗi khi tính sau max[2;A] đến A. Còn với 1 tính max[1;A] sai, và bị lỗi khi tính sau max[1;A] đến A. (A có thể là 1, or 2, or 3, or 4). có lẽ sai này có chung 1 điểm.
bác coi lại giúp em.

Gọi số mặc định của bạn là Num, các số khác Num là A

+1/ Yêu cầu tại bài #1 tới #23 là: tìm Max [Num:A] và khoảng sau max [Num:A] => Đã có Code

+2/ Yêu cầu tại bài #24 tìm Max [Num:Num] và sau khoảng [Num:Num] => Đã sửa Code

+3/ Yêu cầu bài #33 giống #1

*Trưởng hợp 2: lấy Code 1 Test => Báo Code sai
*Trưởng hợp 3: lấy Code 2 Test => Báo Code sai

Bài #31 tôi đã chỉ ra cái sai trong cách làm của bạn và đã nhận được phản hồi

Vâng, đúng là có khác. Thanks bác vậy.

Không biết là tôi hiểu nhầm hay bạn sai?

 

[DanTri007]

Em tìm ra lỗi. Vẫn thắc mắc chút.

 

[DanTri007]

Code không sai mà cái sai là chính bạn không biết mình đang yêu cầu + hỏi cái gì trong quá khứ.

Quá khứ: yêu cầu tìm Max 3A
Hiện tại : áp dụng cho Max 33
Tổng hợp cả 2 trường này bác ah! có lẽ đó là yêu cầu cụ thể của em.=>> code chuẩn ntn?(yêu cầu tính max [3:A]và [3:3] so sánh lấy max và lấy blank sau max)
Trường hợp 3:3 thấy ok rồi.

Bạn dùng cái sau, sửa cái NumConst cho số 1,2,3...

Sub Max3A()
    Dim Arr, Res
    Dim i As Long, j As Long, t As Long, Count3A As Long, CountAA As Long, CountBlk As Long, UCL As Long, CountBlkAfterA As Long, Tmp As Long
    Dim NumConst As Long, Count33 As Long
    NumConst = 1
    Arr = Range("B3:ECQ" & Range("A65536").End(3).Row)
    UCL = UBound(Arr, 2)
    ReDim Res(1 To UBound(Arr, 1), 1 To 5)
    For i = 1 To UBound(Arr, 1)
        For j = 1 To UCL
            '3A===================
            If Arr(i, j) = NumConst Then
                Count3A = 0
                Count33 = 0
                For t = j + 1 To UCL
                    If Arr(i, t) = "" Then
                        Count3A = Count3A + 1
                        Count33 = Count33 + 1
                    ElseIf Arr(i, t) = NumConst Then
                        'Count33----
                        If Res(i, 5) < Count33 Then
                            Res(i, 5) = Count33
                        End If
                        j = t - 1
                        Exit For
                    Else
                        If Res(i, 1) < Count3A Then
                            Res(i, 1) = Count3A
                            Tmp = j + Count3A + 2
                        End If
                        j = t - 1
                        Exit For
                    End If
                Next
            End If
            'AA after 3A ========
            If Tmp Then
                For t = Tmp To UCL
                    If Arr(i, t) = "" Then
                        CountAA = CountAA + 1
                    Else
                        Res(i, 3) = CountAA
                        CountAA = 0
                        Exit For
                    End If
                Next
            End If
            'Blank=====================
            CountBlk = 0
            CountBlkAfterA = 0
            For t = UCL To 1 Step -1
                If Arr(i, t) = "" Then
                    CountBlk = CountBlk + 1
                    CountBlkAfterA = CountBlkAfterA + 1
                ElseIf Arr(i, t) = NumConst Then
                    Res(i, 2) = CountBlk
                    Exit For
                ElseIf Arr(i, t) <> "" Then
                    Res(i, 4) = CountBlkAfterA
                    Exit For
                End If
            Next
            '33==========================
        Next
    Next
    Range("ECV3").Resize(UBound(Arr, 1), 5) = Res
End Sub

bác coi giúp em lại lần cuối. Rất cảm ơn bác. bấy nay em ứng dụng thấy lỗi, nên nhờ bác Dhn46 nhiều!

 

[dhn46]

bác coi giúp em lại lần cuối. Rất cảm ơn bác. bấy nay em ứng dụng thấy lỗi, nên nhờ bác Dhn46 nhiều!

Code bài #32 bạn sửa đoạn 3A một chút chỗ màu đỏ

            '3A===================
            If Arr(i, j) = NumConst Then
                Count3A = 0
                Count33 = 0
                For t = j + 1 To UCL
                    If Arr(i, t) = "" Then
                        Count3A = Count3A + 1
                        Count33 = Count33 + 1
                    [COLOR=#ff0000]ElseIf Arr(i, t) <>"" Then[/COLOR]
                        'Count33----
                        If Res(i, 5) < Count33 Then
                            Res(i, 5) = Count33
                            Tmp = j + Count3A + 2
                        End If
                        j = t - 1
                        Exit For
                    End If
                Next
            End If

Giúp bạn thì không ngại mà ngại là cái "có lẽ" của bạn. Bạn không biết mình hỏi cái gì và muốn cái gì thì những câu hỏi sẽ dài vô tận.

 

[DanTri007]

Em có đặt vấn đề bác mới cho em giải đáp chứ. )
Thanks bác Dhn46!
Thanks GPE!

 

[dhn46]

Em có đặt vấn đề bác mới cho em giải đáp chứ. )
Thanks bác Dhn46!
Thanks GPE!

Spam bạn thêm 1 bài nhé, bạn đừng giận nha.

Góp ý: khi bạn đặt một bài toán thì nên xác định thật rõ rồi hãy hỏi, bởi tôi cũng theo topic của bạn từ đầu với hàng loạt những câu hỏi của bạn và kết luận như bài #34.

Nếu bạn xác định đúng thì cách hỏi và đánh giá sẽ khác bởi mỗi lần bạn hỏi là yêu cầu hoàn toàn khác nhau phải không bạn?

Chúc bạn thành công!