Lọc Tìm Khoảng thời gian nhập hàng và sau đó nhập (1 người xem)

[switch93]

Em là thành viên mới nên chưa biết nhiều mong các bác chỉ bảo
Em có bài toán: Dựa vào mốc nhập hàng lọc tìm khoảng thời gian bao lâu nhập tiếp. các bước bài toán như sau:

B1: các bác lấy tất cả 2 ô kế tiếp nhau có giá trị A và A trong 1 hàng (của mã hàng)làm mốc nhập rồi so sánh mốc nhập xa nhất có thể để đưa ra giá trị nhập sau đó.

B2: sau khi có được giá tri nhập xa nhất, các bác cho em cái giá trị nhập ngay sau đó gần nhất.(Mốc đó nhiều lúc so sánh với chính mốc kế tiếp ví dụ AA:A….AA:A)

B3: Tìm mốc cuối cùng hiện chưa nhập(như mô tả file)

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 ý.

Bài Toán có phần phức tạp các bác xem không hiều cứ cho e ý kiến.

Em có gửi kèm file mô tả.
Xin Cảm ơn GPE!

 

[switch93]

Bác BaTe ah! code có sử dung cho bài toán này đc không? nếu được cần điều chỉnh gì không bác? nếu không được em nên viết đề tài khác không? mong bác và mọi người chỉ bảo? nếu em có gì sai xót.
Cảm ơn GPE!

 

[doveandrose]

nếu chỉ đi tìm 2->A rồi A-2 thì đơn giản quá rồi
tìm A-2

=maxA2($B2:$EQQ2,"A2")

tìm khoảng cách sau A->2

=maxA2($B2:$EQQ2,"A2",2)

khoảng trống cuối cùng của A

=KTSA2(B2:EQQ2,"A")

nếu đổi lại là 2->A thì thay "A2" thành "2A"
khoảng trống cuối cùng của 2

=KTSA2(B2:EQQ2,2)

Public Function maxA2(sourceRG As Range, targetName As String, _
Optional ByVal typeFind As Byte = 1) As Long
Dim Arr As Variant, tempDist As Long, maxDist As Long, isMax As Boolean
Dim r As Long, lastTG As String, afterMax As Long, k As Long
Arr = sourceRG.Value
For r = 1 To UBound(Arr, 2) Step 1
    If IsEmpty(Arr(1, r)) Then
        tempDist = tempDist + 1
    Else
        If isMax Then
            afterMax = tempDist
            isMax = False
        End If
        If lastTG & Arr(1, r) = targetName Then
            If tempDist > maxDist Then
                maxDist = tempDist
                isMax = True
                afterMax = 0
            End If
        End If
        lastTG = Arr(1, r)
        tempDist = 0
    End If
Next
maxA2 = IIf(typeFind = 1, maxDist, afterMax)
End Function

Public Function KTSA2(sourceRG As Range, targetName As Variant) As Variant
Dim r As Long, Arr As Variant, dCount As Long
Arr = sourceRG.Value
For r = UBound(Arr, 2) To 1 Step -1
    If IsEmpty(Arr(1, r)) Then
        dCount = dCount + 1
    Else
        If Arr(1, r) = targetName Then
            KTSA2 = dCount
        Else
            KTSA2 = ""
        End If
        Exit Function
    End If
Next
End Function

 

[switch93]

Public Function GPE_1(Rng As Range, Str As String)
Dim Arr(), J As Long, Dem As Long, N As Long, Tem As String
Arr = Rng.Value
    For J = UBound(Arr, 2) To 1 Step -1
        If Arr(1, J) = "" Then
            Dem = Dem + 1
        Else
            For N = J To J - Len(Str) + 1 Step -1
                Tem = Arr(1, N) & Tem
            Next N
            If Tem = Str Then GPE_1 = Dem
            Exit For
        End If
    Next J
End Function
Public Function GPE_3(Rng As Range, Str As String) As Long
Dim Arr(), J As Long, Dem As Long, Tem As String, L As Long, N As Long
Arr = Rng.Value: L = Len(Str)
For J = L + 1 To UBound(Arr, 2)
    If Arr(1, J) <> "" Then
        Tem = Tem & Arr(1, J)
    Else
        If Tem = Str Then
            For N = J To UBound(Arr, 2)
                If Arr(1, N) = "" Then
                    Dem = Dem + 1
                Else
                    If GPE_3 < Dem Then GPE_3 = Dem
                    Dem = 0
                    J = N - 1
                    Exit For
                End If
            Next N
        End If
        Tem = ""
    End If
Next J
End Function

Public Function GPE_2(Rng As Range, Str As String)
Dim Arr(), I As Long, J As Long, Dem As Long, Tem As String, L As Long, N As Long, LuBu As Long, X As Long
Arr = Rng.Value: L = Len(Str)
LuBu = GPE_3(Rng, Str)
For I = L + 1 To UBound(Arr, 2) - LuBu
    For J = I To I + LuBu - 1
        If Arr(1, J) = "" Then X = X + 1
    Next J
    If X = LuBu Then
        Tem = ""
        For N = I - L To I - 1
            Tem = Tem & Arr(1, N)
        Next N
        If Tem = Str Then
            If Arr(1, I - L - 1) = "" And Arr(1, I + LuBu) <> "" Then
                For N = I + LuBu + 1 To UBound(Arr, 2)
                    If Arr(1, N) = "" Then
                        Dem = Dem + 1
                    Else
                        Exit For
                    End If
                Next N
            End If
        End If
    Else
        X = 0
    End If
Next I
GPE_2 = Dem
End Function

Công thức:

KW2=GPE_1(B2:KV2;"AA")
KX2=GPE_2(B2:KV2;"AA")
KY2=GPE_3(B2:KV2;"AA")

Muốn thay AA bằng AB hay AAA hay ABA gì đó thì thử xem.
Chỉ giải quyết được trước AA hay AAA là ô trống, nếu là số thì chưa xét đến.

Với vụ này bác BaTe đã cho em cái code chạy ổn rồi.
Bác có thể giải quyết bài toán này giúp em đc k?
Bài toàn bài đầu ấy là AA đến 1 giá trị bất kỳ (có thể là 1 hoặc 2). giờ bài toán ấy ngược lại(nói cách khác là bài toán đối xứng, bài toán trước AA=>1 or 2, or 3. bài toán này ngược lại từ 1 or 2 đến AA) từ giá trị bất kỳ đến AA, hoặc AAA được không bác BaTe?
Cảm ơn GPE, Cảm ơn bác BaTe và mọi người quan tâm giúp đỡ em chân ướt chân ráo vào diễn đàn!

 

[switch93]

nếu chỉ đi tìm 2->A rồi A-2 thì đơn giản quá rồi
tìm A-2

=maxA2($B2:$EQQ2,"A2")

tìm khoảng cách sau A->2

=maxA2($B2:$EQQ2,"A2",2)

khoảng trống cuối cùng của A

=KTSA2(B2:EQQ2,"A")

nếu đổi lại là 2->A thì thay "A2" thành "2A"
khoảng trống cuối cùng của 2

=KTSA2(B2:EQQ2,2)

Public Function maxA2(sourceRG As Range, targetName As String, _
Optional ByVal typeFind As Byte = 1) As Long
Dim Arr As Variant, tempDist As Long, maxDist As Long, isMax As Boolean
Dim r As Long, lastTG As String, afterMax As Long, k As Long
Arr = sourceRG.Value
For r = 1 To UBound(Arr, 2) Step 1
    If IsEmpty(Arr(1, r)) Then
        tempDist = tempDist + 1
    Else
        If isMax Then
            afterMax = tempDist
            isMax = False
        End If
        If lastTG & Arr(1, r) = targetName Then
            If tempDist > maxDist Then
                maxDist = tempDist
                isMax = True
                afterMax = 0
            End If
        End If
        lastTG = Arr(1, r)
        tempDist = 0
    End If
Next
maxA2 = IIf(typeFind = 1, maxDist, afterMax)
End Function

Public Function KTSA2(sourceRG As Range, targetName As Variant) As Variant
Dim r As Long, Arr As Variant, dCount As Long
Arr = sourceRG.Value
For r = UBound(Arr, 2) To 1 Step -1
    If IsEmpty(Arr(1, r)) Then
        dCount = dCount + 1
    Else
        If Arr(1, r) = targetName Then
            KTSA2 = dCount
        Else
            KTSA2 = ""
        End If
        Exit Function
    End If
Next
End Function

Khiếu nại bác doveandrose bài toán này bác cũng tính mốc 2 của đoạn [A:2] hoặc đoạn [2:A] này đều lấy liền kề các giá trị khác. không lấy trước và sau A (nếu A là điểm mốc ví A->2) hoặc 2(nếu 2 làm mốc ví như 2-A) là ô trống. bác coi giúp em. Xem chỉnh sửa sao cho phù hợp, em vừa nghiệm thử. hoa hết mắt.
Cảm ơn bác doveandrose!

 

[doveandrose]

Khiếu nại bác doveandrose bài toán này bác cũng tính mốc 2 của đoạn [A:2] hoặc đoạn [2:A] này đều lấy liền kề các giá trị khác. không lấy trước và sau A (nếu A là điểm mốc ví A->2) hoặc 2(nếu 2 làm mốc ví như 2-A) là ô trống. bác coi giúp em. Xem chỉnh sửa sao cho phù hợp, em vừa nghiệm thử. hoa hết mắt.
Cảm ơn bác doveandrose!

bạn diễn tả vậy ai hiểu ? đem file nào sai lên đây . tô màu chỗ nào làm sai

 

[switch93]

bạn diễn tả vậy ai hiểu ? đem file nào sai lên đây . tô màu chỗ nào làm sai

em đã tìm hoa mắt đây bac coi những phần sai có đánh dấu cụ thể đó bác.
Cảm ơn bác!

 

[doveandrose]

Public Function maxA2(sourceRG As Range, targetName As String, _
Optional ByVal typeFind As Byte = 1) As Long
Dim Arr As Variant, tempDist As Long, maxDist As Long, isMax As Boolean
Dim r As Long, lastTG As String, afterMax As Long, k As Long, uc As Long
Arr = sourceRG.Value
uc = UBound(Arr, 2)
For r = 1 To uc Step 1
    If IsEmpty(Arr(1, r)) Then
        tempDist = tempDist + 1
        If r = uc And isMax Then afterMax = tempDist
    Else
        If isMax Then
            afterMax = tempDist
            isMax = False
        End If
        If lastTG & Arr(1, r) = targetName And _
        (r = uc Or Arr(1, WorksheetFunction.Min(r + 1, uc)) = Empty) Then
            If tempDist > maxDist Then
                maxDist = tempDist
                isMax = True
                afterMax = 0
            End If
        End If
        lastTG = IIf(r = 1 Or Arr(1, WorksheetFunction.Max(r - 1, 1)) = Empty, Arr(1, r), "")
        tempDist = 0
    End If
Next
maxA2 = IIf(typeFind = 1, maxDist, afterMax)
End Function

Public Function KTSA2(sourceRG As Range, targetName As Variant) As Variant
Dim r As Long, Arr As Variant, dCount As Long
Arr = sourceRG.Value
For r = UBound(Arr, 2) To 1 Step -1
    If IsEmpty(Arr(1, r)) Then
        dCount = dCount + 1
    Else
        If Arr(1, r) = targetName And Arr(1, r - 1) = Empty Then
            KTSA2 = dCount
        Else
            KTSA2 = ""
        End If
        Exit Function
    End If
Next
End Function

 

[switch93]

Với vụ này bác BaTe đã cho em cái code chạy ổn rồi.
Bác có thể giải quyết bài toán này giúp em đc k?
Bài toàn bài đầu ấy là AA đến 1 giá trị bất kỳ (có thể là 1 hoặc 2). giờ bài toán ấy ngược lại(nói cách khác là bài toán đối xứng, bài toán trước AA=>1 or 2, or 3. bài toán này ngược lại từ 1 or 2 đến AA) từ giá trị bất kỳ đến AA, hoặc AAA được không bác BaTe?
Cảm ơn GPE, Cảm ơn bác BaTe và mọi người quan tâm giúp đỡ em chân ướt chân ráo vào diễn đàn!

Qua quá trình sử dụng có phát sinh điều kiện này: bác cho thêm cái code tô màu vào các ô giá trị liên tiếp đó theo bảng màu tự chọn tùy ý( theo số hiệu quy định).
Chân thành cảm ơn bác.

 

[switch93]

bác BaTe vào chỉ giáo giúp em, bài toán này.