So sánh các khoảng giá trị theo hàng (1 người xem)

  • Thread starter Thread starter switch93
  • Ngày gửi Ngày gửi
Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
S

switch93

Thành viên chính thức
Tham gia
11/8/15
Bài viết
51
Được thích
0
Em nhờ các bác viết code cho bài toán sau:

B1: các bác lấy tất cả 2 ô kế tiếp nhau có giá trị là A trong 1 hàng (của mã hàng)làm mốc nhập rồi so sánh mốc hay chính so sánh các đoạn [AA:AA] với nhau
B2: sau khi có được giá tri so sánh có [AA:AA] Max rồi tô màu đoạn đó và khoảng ô trống ngay sau đó gần nhất.
B3: Tìm mốc cuối cùng có 2 ô liên tiếp có giá trị A
Lưu ý : Trong bài toán này các bác có thể hiểu A có thể là chữ có thể là số thay đổi tùy ý.

em có gửi file đính kèm mong các xem và giúp đỡ.
Bác doveandrose, BaTe, let's gâu gâu.. Qua giúp em.
Cảm ơn GPE, cảm ơn các bác !
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Bài này có nhiều điểm khác bác. còn bên ấy cho đúng chủ điểm bác.
Cảm ơn bác nhắc nhở. Mong bác và mọi giúp đỡ!
 
Upvote 0
tìm [AA:AA] dài nhất
Mã: 
=countMaxAA(B2:CI2,"A")
tìm khoảng trống sau [AA:AA] dài nhất
Mã: 
=countMaxAA(B2:CI2,"A",2)
tìm khoảng trống cuối cùng sau [AA:AA]
Mã: 
=KtcAA(B2:CI2,"A")

Mã: 
Public Function countMaxAA(sourceRng As Range, targetName As String, _
Optional ByVal countType = 1) As Long
Dim arr As Variant, c As Long, tempCount As Long, maxCount As Long, uc As Long
Dim matRegex As Boolean, isAfter As Boolean, afterMax As Long


arr = sourceRng.Value
uc = UBound(arr, 2)
For c = 1 To uc Step 1
    If arr(1, c) = Empty Then
        tempCount = tempCount + 1
        If isAfter And c = uc Then afterMax = tempCount
    Else
        If isAfter Then
            afterMax = tempCount
            isAfter = False
        End If
        If arr(1, c) = targetName And c < uc And _
        arr(1, WorksheetFunction.Min(c + 1, uc)) = targetName And _
        (c + 1 = uc Or arr(1, WorksheetFunction.Min(c + 2, uc)) = Empty) Then
            If maxCount < tempCount And matRegex Then
                maxCount = tempCount
                isAfter = True
                afterMax = 0
            End If
            matRegex = True
            c = c + 1
        Else
            matRegex = False
        End If
        tempCount = 0
    End If
Next
countMaxAA = IIf(countType = 1, maxCount, afterMax)
End Function

Mã: 
Public Function KtcAA(sourceRng As Range, targetName As String) As Variant
Dim arr As Variant, c As Long, countAA As Long
arr = sourceRng.Value
For c = UBound(arr, 2) To 2 Step -1
    If arr(1, c) = Empty Then
        countAA = countAA + 1
    Else
        If arr(1, c) = targetName And arr(1, c - 1) = targetName Then
            KtcAA = countAA
        Else
            KtcAA = ""
        End If
        Exit Function
    End If
Next
End Function
 
Upvote 0
doveandrose đã viết:
tìm [AA:AA] dài nhất
Mã: 
=countMaxAA(B2:CI2,"A")
tìm khoảng trống sau [AA:AA] dài nhất
Mã: 
=countMaxAA(B2:CI2,"A",2)
tìm khoảng trống cuối cùng sau [AA:AA]
Mã: 
=KtcAA(B2:CI2,"A")

Mã: 
Public Function countMaxAA(sourceRng As Range, targetName As String, _
Optional ByVal countType = 1) As Long
Dim arr As Variant, c As Long, tempCount As Long, maxCount As Long, uc As Long
Dim matRegex As Boolean, isAfter As Boolean, afterMax As Long


arr = sourceRng.Value
uc = UBound(arr, 2)
For c = 1 To uc Step 1
    If arr(1, c) = Empty Then
        tempCount = tempCount + 1
        If isAfter And c = uc Then afterMax = tempCount
    Else
        If isAfter Then
            afterMax = tempCount
            isAfter = False
        End If
        If arr(1, c) = targetName And c < uc And _
        arr(1, WorksheetFunction.Min(c + 1, uc)) = targetName And _
        (c + 1 = uc Or arr(1, WorksheetFunction.Min(c + 2, uc)) = Empty) Then
            If maxCount < tempCount And matRegex Then
                maxCount = tempCount
                isAfter = True
                afterMax = 0
            End If
            matRegex = True
            c = c + 1
        Else
            matRegex = False
        End If
        tempCount = 0
    End If
Next
countMaxAA = IIf(countType = 1, maxCount, afterMax)
End Function

Mã: 
Public Function KtcAA(sourceRng As Range, targetName As String) As Variant
Dim arr As Variant, c As Long, countAA As Long
arr = sourceRng.Value
For c = UBound(arr, 2) To 2 Step -1
    If arr(1, c) = Empty Then
        countAA = countAA + 1
    Else
        If arr(1, c) = targetName And arr(1, c - 1) = targetName Then
            KtcAA = countAA
        Else
            KtcAA = ""
        End If
        Exit Function
    End If
Next
End Function
Nhấp chuột vào đây để mở rộng...
code chạy ổn nhưng chưa đúng yêu cầu bác ah! đó là 2 ô kế tiếp cùng chứa giá trị A nhưng trước 2 ô đó k có giá trị nào(là ô trống). bác xem giúp em kể cả khoảng trắng cũng lấy vậy(trước 2 ô kế tiếp không có giá trị nào). thì nó chính xác.
Em xin lỗi bác nha, quên mất điều kiện này. bác coi file giúp em.
 

File đính kèm

Upvote 0
switch93 đã viết:
code chạy ổn nhưng chưa đúng yêu cầu bác ah! đó là 2 ô kế tiếp cùng chứa giá trị A nhưng trước 2 ô đó k có giá trị nào(là ô trống). bác xem giúp em kể cả khoảng trắng cũng lấy vậy(trước 2 ô kế tiếp không có giá trị nào). thì nó chính xác.
Em xin lỗi bác nha, quên mất điều kiện này. bác coi file giúp em.
Nhấp chuột vào đây để mở rộng...

Mã: 
Public Function KtcAA(sourceRng As Range, targetName As String) As Variant
Dim arr As Variant, c As Long, countAA As Long
arr = sourceRng.Value
For c = UBound(arr, 2) To 2 Step -1
    If arr(1, c) = Empty Then
        countAA = countAA + 1
    Else
        [COLOR=#ff0000][SIZE=3][B]If arr(1, c) = targetName And arr(1, c - 1) = targetName Then[/B][/SIZE][/COLOR]
            KtcAA = countAA
        Else
            KtcAA = ""
        End If
        Exit Function
    End If
Next
End Function


sửa lại thành
Mã: 
[COLOR=#ff0000][SIZE=3][B]If arr(1, c) = targetName And arr(1, c - 1) = targetName and  arr(1,c-2) = empty Then[/B][/SIZE][/COLOR]
 
Upvote 0
Phần so sánh các [AA:AA] đó có cũng đáp ứng điều kiện đó ah bác?
Cảm ơn bác doveandrose nhé!
 
Upvote 0
Với bài toán trên em chưa thấy có lỗi phát sinh gì bác Doveandrose ah!
Theo ý kiến của bác em cũng khiếu nại 1 bài cùng dạng bài này.
Bài toán cũng như vậy và yêu cầu như sau
Bài toán Xuôi như sau tìm và so sánh các khoảng [A:XY] (điều kiện trước và sau A trống, A, X và Y có thể là chữ tùy ý. X và Y là 2 ô kế tiếp nhau) sau đó lọc theo các khoảng theo ý bên cạnh như file mô tả tại sheets1. Và tính khoảng trống cuối cùng từ XY
Tương tự như bài toán xuôi ta có bài toán ngược [XY:A] (điều kiện trước và sau XY trống, A, X và Y có thể là chữ tùy ý. X và Y là 2 ô kế tiếp nhau) sau đó lọc theo các khoảng theo ý bên cạnh như file mô tả tại sheets2. Và tính khoảng trống cuối cùng từ A

Nếu có điều gì còn vướng mắc bác cứ ý kiến em biết. Em hiểu đến đó diễn tả đến thế bác thông cảm!
Cảm ơn GPE, Cảm ơn bác Doveandrose đã giúp đỡ!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
switch93 đã viết:
Với bài toán trên em chưa thấy có lỗi phát sinh gì bác Doveandrose ah!
Theo ý kiến của bác em cũng khiếu nại 1 bài cùng dạng bài này.
Bài toán cũng như vậy và yêu cầu như sau
Bài toán Xuôi như sau tìm và so sánh các khoảng [A:XY] (điều kiện trước và sau A trống, A, X và Y có thể là chữ tùy ý. X và Y là 2 ô kế tiếp nhau) sau đó lọc theo các khoảng theo ý bên cạnh như file mô tả tại sheets1.
Tương tự như bài toán xuôi ta có bài toán ngược [XY:A] (điều kiện trước và sau XY trống, A, X và Y có thể là chữ tùy ý. X và Y là 2 ô kế tiếp nhau) sau đó lọc theo các khoảng theo ý bên cạnh như file mô tả tại sheets2.

Nếu có điều gì còn vướng mắc bác cứ ý kiến em biết. Em hiểu đến đó diễn tả đến thế bác thông cảm!
Cảm ơn GPE, Cảm ơn bác Doveandrose đã giúp đỡ!
Nhấp chuột vào đây để mở rộng...

tôi không nhìn thấy mô tả nào trong bất cứ sheet nào .
 
Upvote 0
Bác Doveandrose đã nhận được chưa? các bác coi và quan tâm giúp em với.
Cảm ơn mọi người quan tâm và giúp đỡ!
 
Upvote 0
đếm max [A:XY]
Mã: 
=maxXY(B3:NK3,"A","XY")
sau max [A:XY]
Mã: 
=maxXY(B3:NK3,"A","XY",2)
max [XY:A]
Mã: 
=maxXY(B3:NK3,"XY","A")
sau max [XY:A]
Mã: 
=maxXY(B3:NK3,"XY","A",2)

Mã: 
Public Function maxXY(sourceRG As Range, fromStr As String, toStr As String, _
Optional ByVal countType As Byte = 1) As Long
Dim hisT(1 To 3), arr As Variant, matHead As Boolean, tempCount As Long
Dim c As Long, maxCount As Long, afterMax As Long, isAfter As Boolean, uc As Long


arr = sourceRG.Resize(, sourceRG.Columns.Count + 1).Value
uc = UBound(arr, 2)
arr(1, uc) = ""
For c = 1 To uc Step 1
    If arr(1, c) = "" Then
        If hisT(3) = Right(fromStr, 1) And hisT(2) = Mid(fromStr, 3 - Len(fromStr), 1) And _
        hisT(3 - Len(fromStr)) = "" Then
            matHead = True
        Else
            If hisT(3) = Right(toStr, 1) And hisT(2) = Mid(toStr, 3 - Len(toStr), 1) And _
            hisT(3 - Len(toStr)) = "" And matHead Then
                 If maxCount < tempCount Then
                     maxCount = tempCount
                     isAfter = True
                     afterMax = 0
                 End If
            End If
            If Not hisT(3) = "" Then matHead = False
        End If
        If Not hisT(3) = "" Then tempCount = 0
        If c = uc And isAfter Then afterMax = tempCount
        tempCount = tempCount + 1
    Else
        If isAfter Then
            afterMax = tempCount
            isAfter = False
        End If
    End If
    hisT(1) = hisT(2): hisT(2) = hisT(3): hisT(3) = arr(1, c)
Next
maxXY = IIf(countType = 1, maxCount, afterMax)
End Function
 
Upvote 0
Còn phát khoảng trắng cuối cùng của từng trường hợp sao bác! để em chạy thử. có gì sai xót em khiếu nại sau nha bác.
Rất cảm ơn bác giúp đỡ nhiệt tình!
Cảm ơn GPE!
 
Lần chỉnh sửa cuối:
Upvote 0
doveandrose đã viết:
đếm max [A:XY]
Mã: 
=maxXY(B3:NK3,"A","XY")
sau max [A:XY]
Mã: 
=maxXY(B3:NK3,"A","XY",2)
max [XY:A]
Mã: 
=maxXY(B3:NK3,"XY","A")
sau max [XY:A]
Mã: 
=maxXY(B3:NK3,"XY","A",2)

Mã: 
Public Function maxXY(sourceRG As Range, fromStr As String, toStr As String, _
Optional ByVal countType As Byte = 1) As Long
Dim hisT(1 To 3), arr As Variant, matHead As Boolean, tempCount As Long
Dim c As Long, maxCount As Long, afterMax As Long, isAfter As Boolean, uc As Long


arr = sourceRG.Resize(, sourceRG.Columns.Count + 1).Value
uc = UBound(arr, 2)
arr(1, uc) = ""
For c = 1 To uc Step 1
    If arr(1, c) = "" Then
        If hisT(3) = Right(fromStr, 1) And hisT(2) = Mid(fromStr, 3 - Len(fromStr), 1) And _
        hisT(3 - Len(fromStr)) = "" Then
            matHead = True
        Else
            If hisT(3) = Right(toStr, 1) And hisT(2) = Mid(toStr, 3 - Len(toStr), 1) And _
            hisT(3 - Len(toStr)) = "" And matHead Then
                 If maxCount < tempCount Then
                     maxCount = tempCount
                     isAfter = True
                     afterMax = 0
                 End If
            End If
            If Not hisT(3) = "" Then matHead = False
        End If
        If Not hisT(3) = "" Then tempCount = 0
        If c = uc And isAfter Then afterMax = tempCount
        tempCount = tempCount + 1
    Else
        If isAfter Then
            afterMax = tempCount
            isAfter = False
        End If
    End If
    hisT(1) = hisT(2): hisT(2) = hisT(3): hisT(3) = arr(1, c)
Next
maxXY = IIf(countType = 1, maxCount, afterMax)
End Function
Nhấp chuột vào đây để mở rộng...
Chào bác Doveandrose em chạy rồi chưa ổn khi thay 1X hoặc 1Y(do trong bài có điều kiện X hoặc Y có thể là số hoặc chữ) và phần lọc chưa có mà chạy bác ah! Bác coi lại giúp em với.
Qua toppic mong các bác quan tâm vào giúp đỡ em. Cảm ơn các bác và GPE!
 
Lần chỉnh sửa cuối:
Upvote 0
switch93 đã viết:
Chào bác Doveandrose em chạy rồi chưa ổn khi thay 1X hoặc 1Y và phần lọc chưa có mà chạy bác ah! Bác coi lại giúp em với.
Qua toppic mong các bác quan tâm vào giúp đỡ em. Cảm ơn các bác và GPE!
Nhấp chuột vào đây để mở rộng...

trong những # trước tôi đã nhắc bạn . bây giờ tôi nói lại lần cuối . lần sau tôi sẽ không trả lời nữa
bạn cảm thấy sai ở đâu thì up file lên và tô màu ô nào sai kết quả , bạn nói mà không kèm theo file ai biết sai ở đâu mà sửa
phần cột NN và NO bạn chỉ đưa con số mà không có giải thích mà bắt tôi phải tự hiểu ?
 
Upvote 0
Vâng phần đó em giải thích chưa rõ. ô NN1 đó là phần lọc kết quả các [A:XY] có khoảng trống có giá trị là 3. và sau đó khoảng trống sau 3 gần nhất. cột NO
em cũng gửi file em vừa nghiệm xong bác coi giúp. nếu A=>XY lớn nhất cũng bằng A=>1Y (nếu thay X=1) lớn nhất. nhưng khi chạy code thì không cho kết quả là vậy. bác xem giúp em.
 

File đính kèm

Upvote 0
switch93 đã viết:
Vâng phần đó em giải thích chưa rõ. ô NN1 đó là phần lọc kết quả các [A:XY] có khoảng trống có giá trị là 3. và sau đó khoảng trống sau 3 gần nhất. cột NO
em cũng gửi file em vừa nghiệm xong bác coi giúp. nếu A=>XY lớn nhất cũng bằng A=>1Y (nếu thay X=1) lớn nhất. nhưng khi chạy code thì không cho kết quả là vậy. bác xem giúp em.
Nhấp chuột vào đây để mở rộng...

bạn giải thích như thế về NN và NO tôi không hiểu . trước mắt sửa lại hàm kia đã

Mã: 
Public Function maxXY(sourceRG As Range, fromStr As String, toStr As String, _
Optional ByVal countType As Byte = 1) As Long
Dim hisT(1 To 3) As String, arr As Variant, matHead As Boolean, tempCount As Long
Dim c As Long, maxCount As Long, afterMax As Long, isAfter As Boolean, uc As Long


arr = sourceRG.Resize(, sourceRG.Columns.Count + 1).Value
uc = UBound(arr, 2)
arr(1, uc) = ""
For c = 1 To uc Step 1
    If arr(1, c) = "" Then
        If hisT(3) = Right(toStr, 1) And hisT(2) = Mid(toStr, 3 - Len(toStr), 1) And _
        hisT(3 - Len(toStr)) = "" And matHeadThen
             If maxCount < tempCount Then
                 maxCount = tempCount
                 isAfter = True
                 afterMax = 0
             End If
        End If
        
        If hisT(3) = Right(fromStr, 1) And hisT(2) = Mid(fromStr, 3 - Len(fromStr), 1) And _
        hisT(3 - Len(fromStr)) = "" Then
            matHead = True
        Else
            If Not hisT(3) = "" Then matHead = False
        End If
        
        If hisT(3) <> "" Then tempCount = 0
        If c = uc And isAfter Then afterMax = tempCount
        tempCount = tempCount + 1
    ElseIf isAfter Then
        afterMax = tempCount
        isAfter = False
    End If
    hisT(1) = hisT(2): hisT(2) = hisT(3): hisT(3) = arr(1, c)
Next
maxXY = IIf(countType = 1, maxCount, afterMax)
End Function
 
Upvote 0
doveandrose đã viết:
bạn giải thích như thế về NN và NO tôi không hiểu . trước mắt sửa lại hàm kia đã

Mã: 
Public Function maxXY(sourceRG As Range, fromStr As String, toStr As String, _
Optional ByVal countType As Byte = 1) As Long
Dim hisT(1 To 3) As String, arr As Variant, matHead As Boolean, tempCount As Long
Dim c As Long, maxCount As Long, afterMax As Long, isAfter As Boolean, uc As Long


arr = sourceRG.Resize(, sourceRG.Columns.Count + 1).Value
uc = UBound(arr, 2)
arr(1, uc) = ""
For c = 1 To uc Step 1
    If arr(1, c) = "" Then
        [COLOR=#ff0000]If hisT(3) = Right(toStr, 1) And hisT(2) = Mid(toStr, 3 - Len(toStr), 1) And _
        hisT(3 - Len(toStr)) = "" And matHeadThen[/COLOR]
             If maxCount < tempCount Then
                 maxCount = tempCount
                 isAfter = True
                 afterMax = 0
             End If
        End If
        
        If hisT(3) = Right(fromStr, 1) And hisT(2) = Mid(fromStr, 3 - Len(fromStr), 1) And _
        hisT(3 - Len(fromStr)) = "" Then
            matHead = True
        Else
            If Not hisT(3) = "" Then matHead = False
        End If
        
        If hisT(3) <> "" Then tempCount = 0
        If c = uc And isAfter Then afterMax = tempCount
        tempCount = tempCount + 1
    ElseIf isAfter Then
        afterMax = tempCount
        isAfter = False
    End If
    hisT(1) = hisT(2): hisT(2) = hisT(3): hisT(3) = arr(1, c)
Next
maxXY = IIf(countType = 1, maxCount, afterMax)
End Function
Nhấp chuột vào đây để mở rộng...
Báo lỗi phần này bác coi giúp!
Phần NN đó là lọc những đoạn có A=>XY có giá trị theo yêu cầu 3 hoặc 5 hoặc 6 tùy ý, như bài ra là em cho giá trị 3. sau đó là khoảng trống gần nhất. của giá trị tùy ý.
 
Lần chỉnh sửa cuối:
Upvote 0
Vâng bác. bác coi phần lọc đó giúp em đc k?
 
Upvote 0
tìm max sau [A-XY] = NN
Mã: 
=maxXY(B3:NK3,"A","XY",3,NN3)

Mã: 
Public Function maxXY(sourceRG As Range, fromStr As String, toStr As String, _
Optional ByVal countType As Byte = 1, Optional ByVal countDist As Long = -1) As Long
Dim hisT(1 To 3) As String, arr As Variant, matHead As Boolean, tempCount As Long
Dim c As Long, maxCount As Long, afterMax As Long, isAfter As Boolean, uc As Long


arr = sourceRG.Resize(, sourceRG.Columns.Count + 1).Value
uc = UBound(arr, 2)
arr(1, uc) = ""
For c = 1 To uc Step 1
    If arr(1, c) = "" Then
        If hisT(3) = Right(toStr, 1) And hisT(2) = Mid(toStr, 3 - Len(toStr), 1) And _
        hisT(3 - Len(toStr)) = "" And matHead Then
             If maxCount < tempCount Or countType = 3 Then
                 maxCount = tempCount
                 If countType <> 3 Or countDist = tempCount Then isAfter = True
                 If countType <> 3 Then afterMax = 0
             End If
        End If
        
        If hisT(3) = Right(fromStr, 1) And hisT(2) = Mid(fromStr, 3 - Len(fromStr), 1) And _
        hisT(3 - Len(fromStr)) = "" Then
            matHead = True
        Else
            If Not hisT(3) = "" Then matHead = False
        End If
        
        If hisT(3) <> "" Then tempCount = 0
        If c = uc And isAfter And (countType <> 3 Or afterMax < tempCount) Then afterMax = tempCount
        tempCount = tempCount + 1
    ElseIf isAfter Then
        If countType <> 3 Or afterMax < tempCount Then afterMax = tempCount
        isAfter = False
    End If
    hisT(1) = hisT(2): hisT(2) = hisT(3): hisT(3) = arr(1, c)
Next
maxXY = IIf(countType = 1, maxCount, afterMax)
End Function
 
Upvote 0
Bác chưa hiểu ý em rồi. Ô NN1 em chon giá trị 3 thì tìm theo hàng tất cả các khoảng là A=>XY là 3 còn hàng nào k có bỏ. sau đó tìm khoảng giá trị sau giá trị tùy chọn đó. Giống như bài toán kia, nhưng là lọc các giá trị tùy thích bác ah!
 
Upvote 0
switch93 đã viết:
Bác chưa hiểu ý em rồi. Ô NN1 em chon giá trị 3 thì tìm theo hàng tất cả các khoảng là A=>XY là 3 còn hàng nào k có bỏ. sau đó tìm khoảng giá trị sau giá trị tùy chọn đó. Giống như bài toán kia, nhưng là lọc các giá trị tùy thích bác ah!
Nhấp chuột vào đây để mở rộng...

e2445fbab407be61d533360ad2d9ea41.png



5c15124076a6b9812667f688c8205815.png
 
Upvote 0
Qua quá trình sử dụng em thấy vẫn còn sót lại vài trường hợp bác doveandrose xem xét giúp e.
vẫn làm bài toán cũ nhưng bài toán :
Theo ý kiến của bác em cũng khiếu nại 3 bài toán cùng dạng bài này.

Bài Toán 1:
Bài toán Xuôi như sau tìm và so sánh các khoảng [A:XYZ] (điều kiện trước và sau A trống, A, X, Yvà Z có thể là chữ tùy ý. X, Y và Z là 3 ô kế tiếp nhau) sau đó lọc theo các khoảng theo ý bên cạnh như file mô tả tại sheets1.
Tương tự như bài toán xuôi ta có bài toán ngược [XYZ:A] (điều kiện trước và sau XY trống, A, X, Y và Z có thể là chữ tùy ý. X, Y và Z là 3 ô kế tiếp nhau) sau đó lọc theo các khoảng theo ý bên cạnh như file mô tả tại sheets2.

Bài Toán 2:
Bài toán Xuôi như sau tìm và so sánh các khoảng [AB:XYZ] (điều kiện trước và sau A,B kế tiếp trống, A,B, X, Y và Z có thể là chữ tùy ý. X, Y và Z là 3 ô kế tiếp nhau) sau đó lọc tương tự như bài toán trên.
Tương tự như bài toán xuôi ta có bài toán ngược [XYZ:AB] (điều kiện trước và sau XYZ trống, A,B, X, Y và Z có thể là chữ tùy ý. X, Y và Z là 3 ô kế tiếp nhau) sau đó lọc tương tự như bài toán trên.

Bài Toán 3:
Bài toán Xuôi như sau tìm và so sánh các khoảng [AB:XY] (điều kiện trước và sau A,B kế tiếp trống, A,B, X, Y có thể là chữ tùy ý. X, Y là 2 ô kế tiếp nhau) sau đó lọc tương tự như bài toán trên.

Nếu có điều gì còn vướng mắc bác cứ ý kiến em biết. Em sẽ gửi file 2 bài toán sau bác thông cảm!
Cảm ơn GPE, Cảm ơn bác Doveandrose đã giúp đỡ!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Nhờ GPE, nhờ bác doveandrose qua coi giúp em giải quyết bài toán đó.
Cảm ơn mọi người quan tâm và giúp đỡ!
 
Upvote 0
switch93 đã viết:
Em chưa hiểu lắm bác ah!
Nhấp chuột vào đây để mở rộng...
Bạn di chuột trái vào vùng phía dưới đường kẻ ngang của bài #28 sẽ thấy những chữ tàng hình đó hiện ra.
Anh Doveandrose này hay "lừa tình" lắm đấy, làm việc với anh ấy bạn phải thật tỉnh táo vào....:-=:-=:-=
 
Upvote 0
switch93 đã viết:
Qua quá trình sử dụng em thấy vẫn còn sót lại vài trường hợp bác doveandrose xem xét giúp e.
vẫn làm bài toán cũ nhưng bài toán :
Theo ý kiến của bác em cũng khiếu nại 3 bài toán cùng dạng bài này.

Bài Toán 1:
Bài toán Xuôi như sau tìm và so sánh các khoảng [A:XYZ] (điều kiện trước và sau A trống, A, X, Yvà Z có thể là chữ tùy ý. X, Y và Z là 3 ô kế tiếp nhau) sau đó lọc theo các khoảng theo ý bên cạnh như file mô tả tại sheets1.
Tương tự như bài toán xuôi ta có bài toán ngược [XYZ:A] (điều kiện trước và sau XY trống, A, X, Y và Z có thể là chữ tùy ý. X, Y và Z là 3 ô kế tiếp nhau) sau đó lọc theo các khoảng theo ý bên cạnh như file mô tả tại sheets2.

Bài Toán 2:
Bài toán Xuôi như sau tìm và so sánh các khoảng [AB:XYZ] (điều kiện trước và sau A,B kế tiếp trống, A,B, X, Y và Z có thể là chữ tùy ý. X, Y và Z là 3 ô kế tiếp nhau) sau đó lọc tương tự như bài toán trên.
Tương tự như bài toán xuôi ta có bài toán ngược [XYZ:AB] (điều kiện trước và sau XYZ trống, A,B, X, Y và Z có thể là chữ tùy ý. X, Y và Z là 3 ô kế tiếp nhau) sau đó lọc tương tự như bài toán trên.

Bài Toán 3:
Bài toán Xuôi như sau tìm và so sánh các khoảng [AB:XY] (điều kiện trước và sau A,B kế tiếp trống, A,B, X, Y có thể là chữ tùy ý. X, Y là 2 ô kế tiếp nhau) sau đó lọc tương tự như bài toán trên.

Nếu có điều gì còn vướng mắc bác cứ ý kiến em biết. Em sẽ gửi file 2 bài toán sau bác thông cảm!
Cảm ơn GPE, Cảm ơn bác Doveandrose đã giúp đỡ!
Nhấp chuột vào đây để mở rộng...

cú pháp không có gì thay đổi , đem về chạy thử

Mã: 
Public Function maxXY(sourceRG As Range, ByVal fromStr As String, ByVal toStr As String, _
Optional ByVal countType As Byte = 1, Optional ByVal countDist As Long = -1) As Long
Dim hisT, arr As Variant, matHead As Boolean, tempCount As Long, sTmp As String
Dim c As Long, maxCount As Long, afterMax As Long, isAfter As Boolean, uc As Long
Dim lenFromStr As Long, lenToStr As Long, i As Byte, ubHist As Long


ReDim hisT(1 To WorksheetFunction.Max(Len(fromStr) + 2, Len(toStr) + 2))
ubHist = UBound(hisT)
sTmp = ";"
For c = 1 To Len(fromStr) Step 1
    sTmp = sTmp & ";" & Mid(fromStr, c, 1)
Next
fromStr = sTmp: lenFromStr = Len(fromStr)
sTmp = ";"
For c = 1 To Len(toStr) Step 1
    sTmp = sTmp & ";" & Mid(toStr, c, 1)
Next
toStr = sTmp: lenToStr = Len(toStr)


arr = sourceRG.Resize(, sourceRG.Columns.Count + 1).Value
uc = UBound(arr, 2)
arr(1, uc) = ""
For c = 1 To uc Step 1
    If arr(1, c) = "" Then
        sTmp = Join(hisT, ";")
        If Right(sTmp, Len(fromStr)) = fromStr Then
            matHead = True
        Else
            If Right(sTmp, Len(toStr)) = toStr And matHead Then
                 If maxCount < tempCount Or countType = 3 Then
                     maxCount = tempCount
                     If countType <> 3 Or countDist = tempCount Then isAfter = True
                     If countType <> 3 Then afterMax = 0
                 End If
                 
            End If
            If Not hisT(ubHist) = "" Then matHead = False
        End If
        If Not hisT(ubHist) = "" Then tempCount = 0
         [COLOR=#000000]If c = uc And isAfter And (countType <> 3 Or afterMax < tempCount) Then afterMax = tempCount[/COLOR]
        tempCount = tempCount + 1
    Else
        If isAfter Then
            If countType <> 3 Or afterMax < tempCount Then afterMax = tempCount
            isAfter = False
        End If
    End If
    For i = 1 To ubHist - 1 Step 1
        hisT(i) = hisT(i + 1)
    Next
    hisT(ubHist) = arr(1, c)
Next
maxXY = IIf(countType = 1, maxCount, afterMax)
End Function
 
Upvote 0
hpkhuong đã viết:
Gì thế Diễm. Chữ ký của anh Đỗ Văn Hồng chỉ là cái Note khi cần mà lấy ra thôi...Anh ấy khó nhớ mấy cái câu cửa Miệng đó (nói trắng ra là không nhớ nỗi mà gõ)...Nên anh ấy cố tình để ở dứoi đó thôi... Chứ có gì là bí mật & lừa tềnh đâu Diễm ơi!--=0--=0--=0--=0--=0
Nhấp chuột vào đây để mở rộng...

Thế mà em tưởng đó là gợi ý ảnh viết ra giúp bạn chủ thớt kia chứ >>>hóa ra là takeNote à....Chắc là có 1 sự hiểu nhầm "nhẹ" ở đây .. Sorry sorry ...
Mà cha nội này chả cũng chơi trội quá cơ... takeNote thường thường người ta hay ghi nét to màu đậm còn cha này chả cho "tàng hình " luôn ....
 
Lần chỉnh sửa cuối:
Upvote 0
doveandrose đã viết:
cú pháp không có gì thay đổi , đem về chạy thử

Mã: 
Public Function maxXY(sourceRG As Range, ByVal fromStr As String, ByVal toStr As String, _
Optional ByVal countType As Byte = 1, Optional ByVal countDist As Long = -1) As Long
Dim hisT, arr As Variant, matHead As Boolean, tempCount As Long, sTmp As String
Dim c As Long, maxCount As Long, afterMax As Long, isAfter As Boolean, uc As Long
Dim lenFromStr As Long, lenToStr As Long, i As Byte, ubHist As Long


ReDim hisT(1 To WorksheetFunction.Max(Len(fromStr) + 2, Len(toStr) + 2))
ubHist = UBound(hisT)
sTmp = ";"
For c = 1 To Len(fromStr) Step 1
    sTmp = sTmp & ";" & Mid(fromStr, c, 1)
Next
fromStr = sTmp: lenFromStr = Len(fromStr)
sTmp = ";"
For c = 1 To Len(toStr) Step 1
    sTmp = sTmp & ";" & Mid(toStr, c, 1)
Next
toStr = sTmp: lenToStr = Len(toStr)


arr = sourceRG.Resize(, sourceRG.Columns.Count + 1).Value
uc = UBound(arr, 2)
arr(1, uc) = ""
For c = 1 To uc Step 1
    If arr(1, c) = "" Then
        sTmp = Join(hisT, ";")
        If Right(sTmp, Len(fromStr)) = fromStr Then
            matHead = True
        Else
            If Right(sTmp, Len(toStr)) = toStr And matHead Then
                 If maxCount < tempCount Or countType = 3 Then
                     maxCount = tempCount
                     If countType <> 3 Or countDist = tempCount Then isAfter = True
                     If countType <> 3 Then afterMax = 0
                 End If
                 
            End If
            If Not hisT(ubHist) = "" Then matHead = False
        End If
        If Not hisT(ubHist) = "" Then tempCount = 0
         [COLOR=#000000]If c = uc And isAfter And (countType <> 3 Or afterMax < tempCount) Then afterMax = tempCount[/COLOR]
        tempCount = tempCount + 1
    Else
        If isAfter Then
            If countType <> 3 Or afterMax < tempCount Then afterMax = tempCount
            isAfter = False
        End If
    End If
    For i = 1 To ubHist - 1 Step 1
        hisT(i) = hisT(i + 1)
    Next
    hisT(ubHist) = arr(1, c)
Next
maxXY = IIf(countType = 1, maxCount, afterMax)
End Function
Nhấp chuột vào đây để mở rộng...

bác doveandrose xem cho em cái hàm cho mỗi bài. Giúp em
cảm ơn bác nhiệt tình giúp đỡ.
 
Upvote 0
ppc0312 đã viết:
switch93 lại post file xls kiểm tra kiểu gì, chị nhiệt tình quá đấy, nghỉ đi cho đẹp
Nhấp chuột vào đây để mở rộng...
có kiểm tra được hay không tự tôi biết mà , đâu cần người khác phải thẩm định
có nghỉ đi cho đẹp hay không tự tôi cũng có chủ kiến , không cần đợi người khác chọt vào
 
Upvote 0
switch93 đã viết:
Xin gửi file bác doveandrose coi
Nhấp chuột vào đây để mở rộng...

sửa lại 1 chút
Mã: 
Public Function maxXY(ByVal sourceRG As Range, ByVal fromStr As String, ByVal toStr As String, _
Optional ByVal countType As Byte = 1, Optional ByVal countDist As Long = -1) As Long
Dim hisT, arr As Variant, matHead As Boolean, tempCount As Long, sTmp As String
Dim c As Long, maxCount As Long, afterMax As Long, isAfter As Boolean, uc As Long
Dim i As Byte, ubHist As Long


ReDim hisT(1 To WorksheetFunction.Max(Len(fromStr) + 2, Len(toStr) + 2))
ubHist = UBound(hisT)
sTmp = ";"
For c = 1 To Len(fromStr) Step 1
    sTmp = sTmp & ";" & Mid(fromStr, c, 1)
Next
fromStr = sTmp
sTmp = ";"
For c = 1 To Len(toStr) Step 1
    sTmp = sTmp & ";" & Mid(toStr, c, 1)
Next
toStr = sTmp


arr = sourceRG.Value
ReDim Preserve arr(1 To 1, 1 To UBound(arr, 2) + 1)
uc = UBound(arr, 2)
For c = 1 To uc Step 1
    If arr(1, c) = "" Then
        sTmp = Join(hisT, ";")
        If Right(sTmp, Len(fromStr)) = fromStr Then
            matHead = True
        Else
            If Right(sTmp, Len(toStr)) = toStr And matHead Then
                 If maxCount < tempCount Or countType = 3 Then
                    maxCount = tempCount
                    If countType <> 3 Or countDist = tempCount Then isAfter = True
                    If countType <> 3 Then afterMax = 0
                 End If
                 
            End If
            If Not hisT(ubHist) = "" Then matHead = False
        End If
        If Not hisT(ubHist) = "" Then tempCount = 0
        If c = uc And isAfter And (countType <> 3 Or afterMax < tempCount) Then afterMax = tempCount
        tempCount = tempCount + 1
    Else
        If isAfter Then
            If countType <> 3 Or afterMax < tempCount Then afterMax = tempCount
            isAfter = False
        End If
    End If
    For i = 1 To ubHist - 1 Step 1
        hisT(i) = hisT(i + 1)
    Next
    hisT(ubHist) = arr(1, c)
Next
maxXY = IIf(countType = 1, maxCount, afterMax)
End Function
 
Upvote 0
Các bài toán đã có lời giải, chỉ còn yêu cầu cuối là tìm khoảng trống cuối cùng chưa có.
Bác xem giúp em. file em gửi kèm đây.
Đây là bài toán cuối cùng này.
Xin chân thành cảm ơn bác sự giúp đỡ Tận tình, cảm ơn GPE!
 

File đính kèm

Upvote 0
switch93 đã viết:
Các bài toán đã có lời giải, chỉ còn yêu cầu cuối là tìm khoảng trống cuối cùng chưa có.
Bác xem giúp em. file em gửi kèm đây.
Đây là bài toán cuối cùng này.
Xin chân thành cảm ơn bác sự giúp đỡ Tận tình, cảm ơn GPE!
Nhấp chuột vào đây để mở rộng...

Mã: 
Public Function KTC(ByVal sourceRG As Range, ByVal tex As String)
Dim arr, c As Long, i As Byte, tempCount As Long
arr = sourceRG.Value
For c = UBound(arr, 2) To 1 + Len(tex) Step -1
    If arr(1, c) <> "" Then
        For i = 1 To Len(tex) Step 1
            arr(1, c) = arr(1, c - i) & arr(1, c)
        Next
        If arr(1, c) = tex Then KTC = tempCount Else KTC = ""
        Exit Function
    Else
        tempCount = tempCount + 1
    End If
Next
End Function
 
Upvote 0
Tất cả đều ổn.em kiểm nghiệm tiếp.
Xin cảm ơn Thầy doveandrose chân thành.
Cảm ơn GPE!
 
Lần chỉnh sửa cuối:
Upvote 0
doveandrose đã viết:
Mã: 
Public Function KTC(ByVal sourceRG As Range, ByVal tex As String)
Dim arr, c As Long, i As Byte, tempCount As Long
arr = sourceRG.Value
For c = UBound(arr, 2) To 1 + Len(tex) Step -1
    If arr(1, c) <> "" Then
        For i = 1 To Len(tex) Step 1
            arr(1, c) = arr(1, c - i) & arr(1, c)
        Next
        If arr(1, c) = tex Then KTC = tempCount Else KTC = ""
        Exit Function
    Else
        tempCount = tempCount + 1
    End If
Next
End Function
Nhấp chuột vào đây để mở rộng...

em đã chạy thử vào kết quả trường hợp XY và XYZ tính ô trống cuối cùng vẫn không ổn.
3 ô XYZ hay 2 ô XY phải kế tiếp nhau theo như file. nhưng chạy code ô X và ô Y có khoảng trắng ở giữa vẫn tính. bác coi lại giúp e.
file đây
 

File đính kèm

Upvote 0
switch93 đã viết:
em đã chạy thử vào kết quả trường hợp XY và XYZ tính ô trống cuối cùng vẫn không ổn.
3 ô XYZ hay 2 ô XY phải kế tiếp nhau theo như file. nhưng chạy code ô X và ô Y có khoảng trắng ở giữa vẫn tính. bác coi lại giúp e.
file đây
Nhấp chuột vào đây để mở rộng...

đúng là code đó chạy sai , sửa lại theo cái này rồi báo lại

Mã: 
Public Function KTC(ByVal sourceRG As Range, ByVal tex As String)
Dim arr, c As Long, i As Byte, tempCount As Long, sTmp As String
arr = sourceRG.Value
sTmp = ";"
For c = 1 To Len(tex) Step 1
    sTmp = sTmp & ";" & Mid(tex, c, 1)
Next
For c = UBound(arr, 2) To 1 + Len(tex) Step -1
    If arr(1, c) <> "" Then
        For i = 1 To Len(tex) Step 1
            arr(1, c) = arr(1, c - i) & ";" & arr(1, c)
        Next
        arr(1, c) = ";" & arr(1, c)
        If arr(1, c) = sTmp Then KTC = tempCount Else KTC = ""
        Exit Function
    Else
        tempCount = tempCount + 1
    End If
Next
End Function
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

Momominh
Hỏi công thức tìm tuần thiếu hàng (3 người xem)
Trả lời
1
Đọc
29
hoangtuaotrang_hp_vn
H
2
EM MUỐN TẠO MA TRẬN BIẾN ĐỔI GIÁ TRỊ PHẦN TỬ NGẪU NHIÊN (1 người xem)
Trả lời
2
Đọc
25
ptm0412
ptm0412
V
  • Question Question
Tạo dữ liệu random cho từng sheet dựa theo dữ liệu có sẵn
Trả lời
2
Đọc
69
victoriabmt
V
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định (1 người xem)
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
394
Đọc
46K
ThanhsonLC
T
D
in ra bị thiếu chữ (1 người xem)
Trả lời
2
Đọc
27
dankedun
D
hieuxd
  • Question Question
Khi nhập dữ liệu tự động chèn thêm dòng khi số dòng trong bảng mẫu sắp hết (1 người xem)
Trả lời
24
Đọc
25K
dungpham01
D
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb (1 người xem)
Trả lời
6
Đọc
271
YêuCN
Y
S
Mở 2 cửa sổ riêng biệt
Trả lời
31
Đọc
24K
ThanhNgan240723
T
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
7
Đọc
427
ongke0711
ongke0711
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL (1 người xem)
    • Buồn
Trả lời
57
Đọc
20K
vovietdung261016
V
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Thích
    • Cảm ơn
Trả lời
7
Đọc
1K
PhanTuHuong
PhanTuHuong
huuthang_bd
Add in SwitchSheet: Quay lại các sheet đã xem trước đó bằng phím tắt
    • Thích
    • Yêu thích
2
Trả lời
146
Đọc
42K
phong_codon
P
N
  • Question Question
Hỗ trợ tiếng việt trong macro
Trả lời
14
Đọc
596
Quang_Hải
Quang_Hải
N
Cài phần mềm đọc số ra chữ
Trả lời
2
Đọc
116
Nguyễn Duy Tuân
Nguyễn Duy Tuân
T
Em cần hỗ trợ tách nhiều file và đặt tên theo quy ước chung từ bảng 01 excel có sẳng (2 người xem)
Trả lời
1
Đọc
101
HUONGHCKT
H
N
hàm đếm theo dòng
Trả lời
1
Đọc
87
dungpham01
D
H
LỖI KHOẢNG TRỐNG EXCEL DƯỚI THANH CÔNG CỤ
Trả lời
1
Đọc
60
ptm0412
ptm0412
A
  • Question Question
Share file copy dữ liệu từ tờ khai hải quan.
    • Thích
Trả lời
10
Đọc
986
anhdepjai
A
dungluyen2119
  • Question Question
Code VBA để tính tổng theo chiều ngang mà số cột không cố định
Trả lời
6
Đọc
323
le_vis
L
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom