Tìm các số giống nhau xuất hiện liên tiếp

phuong1604 · 6/3/13

Trong quá trình xử lý dữ liệu, tôi gặp vấn đề nhờ anh/chị giúp:

Trong bảng dữ liệu đính kèm, xét theo từng cột, nếu xuất hiện 4 số không liên tiếp thì note màu xanh, 5 số không liên tiếp thì note màu đỏ (các trường hợp khác không cần)

Rất mong anh/chị giúp đỡ .

Tks

phương1604

hungpecc1 · 6/3/13

phuong1604 đã viết:
Trong quá trình xử lý dữ liệu, tôi gặp vấn đề nhờ anh/chị giúp:

Trong bảng dữ liệu đính kèm, xét theo từng cột, nếu xuất hiện 4 số không liên tiếp thì note màu xanh, 5 số không liên tiếp thì note màu đỏ (các trường hợp khác không cần)

Rất mong anh/chị giúp đỡ .

Tks

phương1604

Bạn có thể giải thích tường mình cụm từ " 4 số không liên tiếp" vì mình xem file của bạn chỉ gồm các số 0,1,2 --> mình hiểu là 4 số liên tiếp thì phải là 01234 --> trong file không thấy có chỗ nào là 4 số liên tiếp cả ---> bạn thử tô màu node ví dụ cụ thể 1 cột được không !

Crystal Rose · 6/3/13

Theo nhóc hiểu thì 4 số không liên tiếp tức là có 4 số 0 liền nhau ví dụ các ô A1, A2,A3, A4 đều bằng 0. Không biết có phải như thế khôg ạ.

huuthang_bd · 6/3/13

Tôi lại nghĩ là bốn số 0 liên tiếp và năm số 0 liên tiếp.
Câu hỏi mập mờ như vậy lại không có kết quả mẫu làm không đúng ý chỉ mất công.

hungpecc1 · 6/3/13

huuthang_bd đã viết:
Tôi lại nghĩ là bốn số 0 liên tiếp và năm số 0 liên tiếp.
Câu hỏi mập mờ như vậy lại không có kết quả mẫu làm không đúng ý chỉ mất công.

thôi cũng tặng bạn ý một đoạn " code mập mờ "--> -+*/

(
[GPECODE=vb]
Sub GPE()
Dim rng As Range, myCell As Range, myColumn As Range
[A1].CurrentRegion.Font.ColorIndex = xlAutomatic
Set rng = [A1].CurrentRegion.Offset(, 1)
For Each myColumn In rng.Areas
For Each myCell In myColumn
If Len(myCell) Then
If IsNumeric(myCell) Then
If Not chk(myCell.Resize(4)) Then
myCell.Resize(4).Font.Color = 1000
ElseIf Not chk(myCell.Resize(5)) Then myCell.Resize(5).Font.Color = 3000
End If
End If
End If
Next
Next
End Sub

Public Function chk(Source As Range) As Boolean
Dim item, Bln As Byte
Dim sArr
sArr = Source.Value
tmp = sArr(1, 1): Bln = 1
For Each item In sArr
If Not tmp Like item Then Bln = 0
Next
chk = Bln
End Function
[/GPECODE]

do chưa đề cập đến tốc đô nên -->với code này bạn đếm từ 1 -1000 để xem kết quả }}}}}

phuong1604 · 7/3/13

Xin lỗi mọi người; hôm qua gửi bài xong không có thời gian để theo dõi. Ý của tôi là 4 số 0 liên tiếp.

Liệu bài này có thể dùng Conditional Formatting được không nhỉ ?

P

SA_DQ · 7/3/13

Bạn thử chạy macro sau trên trang tính của bạn

PHP:

Option Explicit
Sub SoKhongLienTiep()
 Dim jJ As Integer, Ww As Long, Rw As Long, MyAdd As String
 Dim Rng As Range, sRng As Range
 
 For jJ = 2 To 101 '6 To 6'
    Set Rng = Range(Cells(1, jJ), Cells(65500, jJ).End(xlUp))
    Set sRng = Rng.Find(0, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address:               Rw = sRng.Row
        Do
            If Ww = 0 Then
                Ww = Ww + 1
            Else
                If sRng.Row = Rw + 1 Then
                    Ww = Ww + 1
                    Rw = Rw + 1
                    If Ww = 4 Then _
                        Range(sRng, sRng.Offset(-3)).Interior.ColorIndex = 5
                    If Ww = 5 Then _
                        Range(sRng, sRng.Offset(-4)).Interior.ColorIndex = 3
                    If Ww > 5 Then _
                        Range(sRng, sRng.Offset(-Ww + 1)).Interior.ColorIndex = 0
                Else
                    Ww = 1:                     Rw = sRng.Row
                End If
            End If
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        Ww = 0
    Else
        MsgBox "Nothing"
    End If
 Next jJ
End Sub

Crystal Rose · 7/3/13

HYen17 đã viết:

PHP:

Option Explicit
Sub SoKhongLienTiep()
 Dim jJ As Integer, Ww As Long, Rw As Long, MyAdd As String
 Dim Rng As Range, sRng As Range
 
 For jJ = 2 To 101 '6 To 6'
    Set Rng = Range(Cells(1, jJ), Cells(65500, jJ).End(xlUp))
    Set sRng = Rng.Find(0, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address:               Rw = sRng.Row
        Do
            If Ww = 0 Then
                Ww = Ww + 1
            Else
                If sRng.Row = Rw + 1 Then
                    Ww = Ww + 1
                    Rw = Rw + 1
                    If Ww = 4 Then _
                        Range(sRng, sRng.Offset(-3)).Interior.ColorIndex = 5
                    If Ww = 5 Then _
                        Range(sRng, sRng.Offset(-4)).Interior.ColorIndex = 3
                    If Ww > 5 Then _
                        Range(sRng, sRng.Offset(-Ww + 1)).Interior.ColorIndex = 0
                Else
                    Ww = 1:                     Rw = sRng.Row
                End If
            End If
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        Ww = 0
    Else
        MsgBox "Nothing"
    End If
 Next jJ
End Sub

Tiền bối ơi bài này có thể dùng cách khác như lập công thức như thế nào rồi dùng Conditional Formatting được không ạ?

ChanhTQ@ · 7/3/13

Hỏi tiền bối đó mà hỏi công thức thì thà hỏi đầu gối còn hơn!

[ThongBao]Tiền bối ơi bài này có thể dùng cách khác như lập công thức như thế nào rồi dùng Conditional Formatting được không ạ?[/ThongBao]
Để khỏi mắc tội SPAM:

PHP:

Option Explicit
Sub SoKhongLienTiep()
 Dim jJ As Integer, Ww As Long, Rw As Long, eRw As Long 
 Dim MyAdd As String
 Dim Rng As Range, sRng As Range
 
 eRw=[A1].End(xlDown).Row
 For jJ = 2 To 101 '6 To 6'
    Set Rng = Range(Cells(1, jJ), Cells(eRw, jJ))
    Rng.Interior.ColorIndex=0
    Set sRng = Rng.Find(0, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address:               Rw = sRng.Row
        Do
            If Ww = 0 Then
                Ww = Ww + 1
            Else
                If sRng.Row = Rw + 1 Then
                    Ww = Ww + 1
                    Rw = Rw + 1
                    If Ww = 4 Then _
                        Range(sRng, sRng.Offset(-3)).Interior.ColorIndex = Ww * 9
                    If Ww = 5 Then _
                        Range(sRng, sRng.Offset(-4)).Interior.ColorIndex = Ww * 7
                    If Ww = 6 Then _
                        Range(sRng, sRng.Offset(-Ww + 1)).Interior.ColorIndex = 0
                Else
                    Ww = 1:                     Rw = sRng.Row
                End If
            End If
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        Ww = 0
    Else
        MsgBox "Nothing"
    End If
 Next jJ
End Sub

VetMini · 7/3/13

Lập một hàm đếm số không ở trên, một hàm đếm số không ở dưới. Với mỗi ô có trị 0, gọi hai hàm này, cộng lại xem 4 hay > 5 thì format.
Tương tự cho số không bên phải và bên trái.

Hàm thì dễ viết, chỉ chịu khó để ý ở mấy cái vị trí bìa.

Crystal Rose · 7/3/13

ChanhTQ@ đã viết:
[ThongBao]Tiền bối ơi bài này có thể dùng cách khác như lập công thức như thế nào rồi dùng Conditional Formatting được không ạ?[/ThongBao]

Dạ nhóc không biết gì về code mà tiền bối biết viết code thì chắc về công thức sẽ rất giỏi ạ.

leonguyenz · 7/3/13

phuong1604 đã viết:
Xin lỗi mọi người; hôm qua gửi bài xong không có thời gian để theo dõi. Ý của tôi là 4 số 0 liên tiếp.

Liệu bài này có thể dùng Conditional Formatting được không nhỉ ?

P

Có thể dùng công thức trong CF:
Bạn xem trong file:

Quang_Hải · 7/3/13

Tham gia code cho vui, tốc độ cũng khá nhưng vẫn còn mập mờ quá. Nếu 6 số 0 liên tiếp thì sao? 10 số 0 liên tiếp thì đỏ và xanh hay đỏ hết???

PHP:

Sub tomau()
Dim data(), i, n
data = [A1].CurrentRegion.Value
ActiveSheet.UsedRange.Interior.ColorIndex = xlNone
For n = 2 To UBound(data, 2)
   For i = 1 To UBound(data) - 4
      If data(i, n) = 0 Then
         If data(i + 1, n) = 0 Then
            If data(i + 2, n) = 0 Then
               If data(i + 3, n) = 0 Then
                  If data(i + 4, n) = 0 Then
                     Cells(i, n).Resize(5).Interior.ColorIndex = 3
                     i = i + 4
                  Else
                     Cells(i, n).Resize(4).Interior.ColorIndex = 8
                     i = i + 3
                  End If
               End If
            End If
         End If
      End If
   Next
Next
End Sub

bebo021999 · 7/3/13

@leonguyenz và quanghai: chỉ xét 4 và 5 số 0 thôi, chứ 4 số và >5 số 0 thì dễ rồi.

leonguyenz · 7/3/13

bebo021999 đã viết:
@leonguyenz và quanghai: chỉ xét 4 và 5 số 0 thôi, chứ 4 số và >5 số 0 thì dễ rồi.

Chưa thấy chủ thớt nói gì nên xem đó là 1 giải pháp.
Nếu chỉ tính 4 số 0 và 5 số 0 thì công thức khó khả thi, hoặc sử dụng cột phụ.

bebo021999 · 7/3/13

leonguyenz đã viết:
Chưa thấy chủ thớt nói gì nên xem đó là 1 giải pháp.
Nếu chỉ tính 4 số 0 và 5 số 0 thì công thức khó khả thi, hoặc sử dụng cột phụ.

Làm được Thảo à, thử làm theo hướng này xem:
* Tại số 0 bất kỳ, tìm vị trí số >0 cuối cùng bên trái và đầu tiên bên phải.
* Dùng hiệu số giữa 2 vị trí để làm CF

autokiss · 15/3/13

Mình thấy người hỏi hơi vô trách nhiệm, làm như thế đúng hay không cũng phải nói chứ cứ vào "cám ơn" mà được à?

Tìm các số giống nhau xuất hiện liên tiếp

Thành viên thường trực

File đính kèm

Thành viên gắn bó

Dịu dàng nhất Web

Chuyên gia GPE

Thành viên gắn bó

Thành viên thường trực

/(hông là gì!

Dịu dàng nhất Web

0901452không62

Ăn cùng góc phố

Dịu dàng nhất Web

Thành viên gạo cội

File đính kèm

Thành viên gạo cội

Thành viên gạo cội

Thành viên gạo cội

Thành viên gạo cội

Thành viên hoạt động

Facebook

Group