Tô màu ô các ô có dãy số theo điều kiện: số ở một vị trí trong dãy số lớn hơn hoặc nhỏ hơn một số nào đó

Hoàng Tuấn 868 · 6/10/21

Bùi Thúy Thúy đã viết:
Dạ được anh, vậy xét số thứ 2 từ phải sang được ạ!
Anh giúp em với ạ!

Mình viết dài hơn code của anh Concogia nhiều nên không gửi lên nữa bạn ạ.

Bùi Thúy Thúy · 6/10/21

concogia đã viết:
Bài này chắc phải dùng VBA, bạn cứ nhập dữ liệu dạng text bình thường cho đủ 5 ký tự, làm thử thôi, có gì bàn tiếp, code viết chưa chỉnh cho gọn
Bấm vào con mè

Em cảm ơn anh!
Bài anh giúp em thấy: những dãy số có 3 hoặc 4 số (do có chữ số 0 ở đầu thì ô đó vẫn bị tô)
Anh giúp em với ạ!

Bài đã được tự động gộp: 6/10/21

Hoàng Tuấn 868 đã viết:
Mình viết dài hơn code của anh Concogia nhiều nên không gửi lên nữa bạn ạ.

Dạ! anh gửi cho em thêm khảo thêm với ạ!

HieuCD · 6/10/21

Bùi Thúy Thúy đã viết:
Em có bài toán sau xin được các thầy, các anh/chị giúp:
Từ cột D đến cột O là tháng 01 đến tháng 12, cột C tương ứng ngày trong tháng.
Mỗi một ngày trong tháng tương ứng xuất hiện dãy số có 5 chữ số.
- Nếu số ở vị trí thứ 4 trong các dãy số đó (tính theo chiều từ trái sang phải trong dãy số) mà < 5 và xuất hiện liên tục trong 6 ngày trở lên (ngày này liền nhau, liên tục, nếu có ngày không có dãy số chèn vào thì ngày đó sẽ bỏ trống) thì được tô màu cam. Và nếu >= 5 và xuất hiện trong 6 ngày trở lên (ngày này liền nhau, liên tục, nếu có ngày không có dãy số chèn vào thì ngày đó sẽ bỏ trống) thì tô màu xanh.
Như hình dưới em làm bằng tay.
Em xin cảm ơn!
View attachment 267236

Chạy code

Mã:

Sub XYZ()
  Dim rng As Range, rngC As Range, rngX As Range, tmp
  Dim sRow&, sCol&, i&, j&

  Set rng = Range("D7:O" & Range("C" & Rows.Count).End(xlUp).Row)
  rng.Interior.ColorIndex = 0
  sRow = rng.Rows.Count: sCol = rng.Columns.Count
  For j = 1 To sCol
    For i = 1 To sRow
      If Len(rng(i, j).Value) > 0 Then
        tmp = Mid(Format(rng(i, j).Value, "00000"), 4, 1)
        If tmp < "5" Then
          Call ToMau(rngC, rngX, rng(i, j), 43)
        Else
          Call ToMau(rngX, rngC, rng(i, j), 45)
        End If
      End If
    Next i
  Next j
  If Not rngC Is Nothing Then
    If rngC.Count > 5 Then rngC.Interior.ColorIndex = 45
  ElseIf Not rngX Is Nothing Then
    If rngX.Count > 5 Then rngX.Interior.ColorIndex = 43
  End If
End Sub

Sub ToMau(ByRef rng1, ByRef rng2, ByVal iCell As Range, ByVal ColorId&)
  If rng1 Is Nothing Then
    Set rng1 = iCell
    If Not rng2 Is Nothing Then
      If rng2.Count > 5 Then rng2.Interior.ColorIndex = ColorId
      Set rng2 = Nothing
    End If
  Else
    Set rng1 = Union(rng1, iCell)
  End If
End Sub

concogia · 6/10/21

Bùi Thúy Thúy đã viết:
Em cảm ơn anh!
Bài anh giúp em thấy: những dãy số có 3 hoặc 4 số (do có chữ số 0 ở đầu thì ô đó vẫn bị tô)
Anh giúp em với ạ!

Bài đã được tự động gộp: 6/10/21

Bạn nói tất cả dãy số đều 5 ký tự mà ( có thể 1 hoặc 2 số "zero" ở đầu), bạn cứ thêm cho đủ, dữ liệu lúc đó trộn lẫn "Text" & "Num" hoặc "Text" hết đều được. Bạn chạy code rồi chỉ chỗ nào chưa đúng giúp mình
Thân

CHAOQUAY · 6/10/21

Bùi Thúy Thúy đã viết:
Em có bài toán sau xin được các thầy, các anh/chị giúp:
Từ cột D đến cột O là tháng 01 đến tháng 12, cột C tương ứng ngày trong tháng.
Mỗi một ngày trong tháng tương ứng xuất hiện dãy số có 5 chữ số.
- Nếu số ở vị trí thứ 4 trong các dãy số đó (tính theo chiều từ trái sang phải trong dãy số) mà < 5 và xuất hiện liên tục trong 6 ngày trở lên (ngày này liền nhau, liên tục, nếu có ngày không có dãy số chèn vào thì ngày đó sẽ bỏ trống) thì được tô màu cam. Và nếu >= 5 và xuất hiện trong 6 ngày trở lên (ngày này liền nhau, liên tục, nếu có ngày không có dãy số chèn vào thì ngày đó sẽ bỏ trống) thì tô màu xanh.
Như hình dưới em làm bằng tay.
Em xin cảm ơn!
View attachment 267236

Test xem sao

Mã:

Option Explicit

Sub xxx()
Dim TgLt, congTg
Dim test As Boolean
Dim i, j, k, x, y, z, t
TgLt = 6
With Sheet3
    .UsedRange.Interior.Color = xlNone
    t = (.Range("D7").Value Mod 100) \ 10
    test = t < 5
    congTg = 1
    For k = 2 To 31 * 12
        i = (k - 1) Mod 31 + 7
        j = (k - 1) \ 31 + 4
        If .Cells(i, j).Value <> "" Then t = (.Cells(i, j).Value Mod 100) \ 10
        If Not (test Xor (t < 5)) Then
            congTg = congTg + 1
        Else
            congTg = 1
            test = Not test
        End If
       
        If congTg = TgLt Then
            For z = k To k - congTg + 1 Step -1
                x = (z - 1) Mod 31 + 7
                y = (z - 1) \ 31 + 4
                If .Cells(x, y) <> "" Then .Cells(x, y).Interior.Color = IIf(test, 49407, 5287936)
            Next z
        Else
            If congTg > TgLt Then
                If .Cells(i, j) <> "" Then .Cells(i, j).Interior.Color = IIf(test, 49407, 5287936)
            End If
        End If
    Next k
End With
End Sub

Bùi Thúy Thúy · 6/10/21

concogia đã viết:
Bạn nói tất cả dãy số đều 5 ký tự mà ( có thể 1 hoặc 2 số "zero" ở đầu), bạn cứ thêm cho đủ, dữ liệu lúc đó trộn lẫn "Text" & "Num" hoặc "Text" hết đều được. Bạn chạy code rồi chỉ chỗ nào chưa đúng giúp mình
Thân

Dạ em cảm ơn anh!

Bài đã được tự động gộp: 6/10/21

HieuCD đã viết:

Chạy code

Mã:

Sub XYZ()
  Dim rng As Range, rngC As Range, rngX As Range, tmp
  Dim sRow&, sCol&, i&, j&

  Set rng = Range("D7:O" & Range("C" & Rows.Count).End(xlUp).Row)
  rng.Interior.ColorIndex = 0
  sRow = rng.Rows.Count: sCol = rng.Columns.Count
  For j = 1 To sCol
    For i = 1 To sRow
      If Len(rng(i, j).Value) > 0 Then
        tmp = Mid(Format(rng(i, j).Value, "00000"), 4, 1)
        If tmp < "5" Then
          Call ToMau(rngC, rngX, rng(i, j), 43)
        Else
          Call ToMau(rngX, rngC, rng(i, j), 45)
        End If
      End If
    Next i
  Next j
  If Not rngC Is Nothing Then
    If rngC.Count > 5 Then rngC.Interior.ColorIndex = 45
  ElseIf Not rngX Is Nothing Then
    If rngX.Count > 5 Then rngX.Interior.ColorIndex = 43
  End If
End Sub

Sub ToMau(ByRef rng1, ByRef rng2, ByVal iCell As Range, ByVal ColorId&)
  If rng1 Is Nothing Then
    Set rng1 = iCell
    If Not rng2 Is Nothing Then
      If rng2.Count > 5 Then rng2.Interior.ColorIndex = ColorId
      Set rng2 = Nothing
    End If
  Else
    Set rng1 = Union(rng1, iCell)
  End If
End Sub

Được rồi ạ! em cảm ơn anh @HieuCD

Bài đã được tự động gộp: 6/10/21

CHAOQUAY đã viết:

Test xem sao

Mã:

Option Explicit

Sub xxx()
Dim TgLt, congTg
Dim test As Boolean
Dim i, j, k, x, y, z, t
TgLt = 6
With Sheet3
    .UsedRange.Interior.Color = xlNone
    t = (.Range("D7").Value Mod 100) \ 10
    test = t < 5
    congTg = 1
    For k = 2 To 31 * 12
        i = (k - 1) Mod 31 + 7
        j = (k - 1) \ 31 + 4
        If .Cells(i, j).Value <> "" Then t = (.Cells(i, j).Value Mod 100) \ 10
        If Not (test Xor (t < 5)) Then
            congTg = congTg + 1
        Else
            congTg = 1
            test = Not test
        End If
      
        If congTg = TgLt Then
            For z = k To k - congTg + 1 Step -1
                x = (z - 1) Mod 31 + 7
                y = (z - 1) \ 31 + 4
                If .Cells(x, y) <> "" Then .Cells(x, y).Interior.Color = IIf(test, 49407, 5287936)
            Next z
        Else
            If congTg > TgLt Then
                If .Cells(i, j) <> "" Then .Cells(i, j).Interior.Color = IIf(test, 49407, 5287936)
            End If
        End If
    Next k
End With
End Sub

em cảm ơn anh ạ!

Tô màu ô các ô có dãy số theo điều kiện: số ở một vị trí trong dãy số lớn hơn hoặc nhỏ hơn một số nào đó

Hoàng Tuấn 868

Đăng ký hôm qua

Bùi Thúy Thúy

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

HieuCD

Chuyên gia GPE

concogia

Gội rồi mới Cạo

CHAOQUAY

Thành viên gắn bó

Bùi Thúy Thúy

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

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

Facebook

Group

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