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
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

A
  • Question Question
Viết code tạo mã hàng hóa (7 người xem)
Trả lời
6
Đọc
76
A HOANG 620
A
K
Không đăng nhập được MS Teams sau khi tải về (chỉ cho sử dụng bản trên web) (1 người xem)
Trả lời
3
Đọc
47
K&B
K
D
Nhờ mọi người giúp với. file đính kèm ạh (3 người xem)
    • Cười
Trả lời
6
Đọc
107
SA_DQ
SA_DQ
A
  • Question Question
Nhờ các bác giúp em viết code để trích lọc và so sánh với 5 điều kiện. Em suy nghĩ mãi không làm được. em cám ơn (1 người xem)
Trả lời
5
Đọc
143
A HOANG 620
A
H
Phân quyền xem trên từng trang tính của googlesheet (1 người xem)
Trả lời
5
Đọc
91
Hoale85
H
H
Hàm Evaluate bị lỗi khi mở lại (1 người xem)
Trả lời
12
Đọc
154
ptm0412
ptm0412
T
Nhờ ACE chỉ giáo công thức Gộp nhiều dữ liệu vào một ô trong excel (2 người xem)
Trả lời
6
Đọc
148
thuong-minh
T
E
Tính tổng tiền theo điều kiện (1 người xem)
Trả lời
5
Đọc
141
mimosa1972
M
vnxgiokinhtoi
Nhờ giúp đỡ công thức lưu dữ liệu và mở lại dữ liệu cũ đã save (1 người xem)
Trả lời
0
Đọc
44
vnxgiokinhtoi
vnxgiokinhtoi
N
  • Question Question
TÌM TÊN CỘT VÀ COPY CẢ CỘT SANG SHEET KHÁC BẰNG VBA (2 người xem)
Trả lời
5
Đọc
145
ngoc0977760224
N
N
  • Question Question
VBA - copy các sheets unhide và dạng giá trị theo vùng xác định
Trả lời
7
Đọc
429
nguyenhuong91
N
H
  • Question Question
Gửi mail hàng loạt với mỗi mail là 1 file PDF đính kèm khác nhau
Trả lời
2
Đọc
170
Cúc Hr
C
M
  • Question Question
Tự chèn dòng khi cập nhật dữ liệu từ trang tính khác. (1 người xem)
Trả lời
5
Đọc
228
Cúc Hr
C
PhanTuHuong
Nên chọn điện thoại nào?
Trả lời
17
Đọc
1K
minhminh27
minhminh27
N
Em đang muốn tìm sách. Tài.liệu về dashboard và báo cáo, biểu đồ excel tiếng việt (1 người xem)
Trả lời
1
Đọc
80
ptm0412
ptm0412
Q
Phát tiếng khi code chạy ra giá trị yêu cầu (2 người xem)
    • Cười
Trả lời
3
Đọc
161
DeTong
D
A
  • Question Question
nhờ anh chị, chú bác giúp em gom gọn phần code phía dưới giúp em. Sao bị lỗi ở dòng 24, 25, 26 nữa ạ. em cám ơn
Trả lời
3
Đọc
103
Hoàng Tuấn 868
H
J
Excel 2019, lỗi không thể insert được biểu đồ (chart)
Trả lời
12
Đọc
4K
ptm0412
ptm0412
C
Lọc chỉ tiêu sheet 1, kết quả tự động ở các sheet còn lại
Trả lời
10
Đọc
205
thuytrangbp28
T
A
  • Question Question
Em nhờ anh/chị/em/chú/bác giúp em viết code tổng hợp dữ liệu. em tính công thức nó nặng quá. em cám ơn (1 người xem)
Trả lời
13
Đọc
391
HUONGHCKT
H
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom