Tô màu có điều kiện

[vanhungss89]

Chào các bro , em có 1 file đính kèm thuộc về kỹ thuật, nhưng có bài toán này em không giải được , các bác giúp em chứ đau đầu quá , làm tay thì còn lâu lắm mới xong được .
Kiểu như thế này : sợi cáp sẽ chiếm số dòng không cố định trong list , ví dụ sợi A1(Địa chỉ cột A dòng 3) sẽ chiến số dòng từ dòng 3 đến dòng 7.
Vậy em có bài toán như sau , Nếu như cột P xuất hiện giá trị khác 0 thì sẽ tô màu cho sợi cáp đó ( tô tất cả các dòng thuộc sợi đó) .
Cám ơn các bác

 

[phulien1902]

Chào các bro , em có 1 file đính kèm thuộc về kỹ thuật, nhưng có bài toán này em không giải được , các bác giúp em chứ đau đầu quá , làm tay thì còn lâu lắm mới xong được .
Kiểu như thế này : sợi cáp sẽ chiếm số dòng không cố định trong list , ví dụ sợi A1(Địa chỉ cột A dòng 3) sẽ chiến số dòng từ dòng 3 đến dòng 7.
Vậy em có bài toán như sau , Nếu như cột P xuất hiện giá trị khác 0 thì sẽ tô màu cho sợi cáp đó ( tô tất cả các dòng thuộc sợi đó) .
Cám ơn các bác

Bạn thử

Sub abc()
Columns("P:P").SpecialCells(xlCellTypeConstants, 2).Interior.ColorIndex = 36
End Sub

 

[batman1]

Nếu như cột P xuất hiện giá trị khác 0 thì sẽ tô màu cho sợi cáp đó ( tô tất cả các dòng thuộc sợi đó) .
Cám ơn các bác

Giá trị có thể xuất hiện trong cột P ở dòng bất kỳ hay nếu xuất hiện thì chỉ tính ở P3, P8, P14, P20, ...?

Nếu chỉ tính ở P3, P8, P14, P20, ..., chỉ tính 2 trạng thái "có dữ liệu / trống", thì: chọn A3:N9000 -> CF -> New Rule -> "Use a formula ..." -> gõ công thức

=LOOKUP("zzz",$A$3:$A3,$P$3:$P3)<>""

-> chọn mầu

 

[vanhungss89]

Bạn thử

Sub abc()
Columns("P:P").SpecialCells(xlCellTypeConstants, 2).Interior.ColorIndex = 36
End Sub

Như thế này chỉ tô màu ô có giá trị <>0 , em muốn là ví dụ P8<>0 , thì sẽ tô P8 đến P13 .

 

[vanhungss89]

Giá trị có thể xuất hiện trong cột P ở dòng bất kỳ hay nếu xuất hiện thì chỉ tính ở P3, P8, P14, P20, ...?

Nếu chỉ tính ở P3, P8, P14, P20, ..., chỉ tính 2 trạng thái "có dữ liệu / trống", thì: chọn A3:N9000 -> CF -> New Rule -> "Use a formula ..." -> gõ công thức

=LOOKUP("zzz",$A$3:$A3,$P$3:$P3)<>""

-> chọn mầu

Giá trị chỉ xuất hiện ở P3,P8,P14... Nhưng khi xuất hiện thì em muốn tô cả các ô dưới ô xuất hiện giá trị. ví dụ P3 có giá trị thì tô P3 đến P7 (sợi cáp này nó chiếm từ dòng 3 đến 7)

 

[HieuCD]

Giá trị chỉ xuất hiện ở P3,P8,P14... Nhưng khi xuất hiện thì em muốn tô cả các ô dưới ô xuất hiện giá trị. ví dụ P3 có giá trị thì tô P3 đến P7 (sợi cáp này nó chiếm từ dòng 3 đến 7)

Chạy code

Sub GPE()
  Dim Rng As Range, i As Long, eRow As Long, fRow As Long, iColor As Byte
  Application.ScreenUpdating = False
  eRow = Range("E65500").End(xlUp).Row
  If eRow > 2 Then
    For Each Rng In Range("P3:P" & eRow).SpecialCells(xlCellTypeConstants, 2)
      fRow = Rng.Row
      For i = fRow + 1 To eRow + 1
        If Len(Range("A" & i).Value) > 0 Or Len(Range("E" & i).Value) = 0 Then
          If iColor = 36 Then iColor = 37 Else iColor = 36
          Rng.Resize(i - fRow).Interior.ColorIndex = iColor
          Exit For
        End If
      Next i
    Next
  End If
  Application.ScreenUpdating = True
End Sub

 

[vanhungss89]

Chạy code

Sub GPE()
  Dim Rng As Range, i As Long, eRow As Long, fRow As Long, iColor As Byte
  Application.ScreenUpdating = False
  eRow = Range("E65500").End(xlUp).Row
  If eRow > 2 Then
    For Each Rng In Range("P3:P" & eRow).SpecialCells(xlCellTypeConstants, 2)
      fRow = Rng.Row
      For i = fRow + 1 To eRow + 1
        If Len(Range("A" & i).Value) > 0 Or Len(Range("E" & i).Value) = 0 Then
          If iColor = 36 Then iColor = 37 Else iColor = 36
          Rng.Resize(i - fRow).Interior.ColorIndex = iColor
          Exit For
        End If
      Next i
    Next
  End If
  Application.ScreenUpdating = True
End Sub

Lỗi bac ạ , bác chỉnh lại giúp em được không

 

[vanhungss89]

View attachment 196861Lỗi bac ạ , bác chỉnh lại giúp em được không

 

[ndu96081631]

Bài này thấy dùng 1 vòng lập cũng được:

Sub Test()
  Dim rngArea As Range, rng As Range, rngTarget As Range
  Dim bChk As Boolean
  Set rng = Range("A3:A8363")
  For Each rngArea In rng.SpecialCells(xlCellTypeBlanks).Areas
    Set rngTarget = Union(rngArea.Offset(, 15), rngArea(1, 1).Offset(-1, 15))
    If rngTarget(1).Value <> Empty Then
      bChk = Not bChk
      rngTarget.Interior.ColorIndex = IIf(bChk, 36, 35)
    End If
  Next
End Sub

 

[HieuCD]

View attachment 196864

Bấm nút lệnh chạy code

 

[vanhungss89]

Bấm nút lệnh chạy code

Ngon quá bac ê , nhưng bác có thể chỉnh thành tô 1 màu được không , em thấy nó đang tô màu xen kẽ

 

[HieuCD]

Ngon quá bac ê , nhưng bác có thể chỉnh thành tô 1 màu được không , em thấy nó đang tô màu xen kẽ

Tô màu xen kẻ để dể quan sát, nếu chỉ dùng 1 màu thì tìm lệnh tương tự
Rng.Resize(i - fRow).Interior.ColorIndex = iColor
thay iColor bằng con số cụ thể, ví dụ
Rng.Resize(i - fRow).Interior.ColorIndex = 36
và bỏ dòng lệnh xen kẻ màu
If iColor = 36 Then iColor = 37 Else iColor = 36

 

[vanhungss89]

Tô màu xen kẻ để dể quan sát, nếu chỉ dùng 1 màu thì tìm lệnh tương tự
Rng.Resize(i - fRow).Interior.ColorIndex = iColor
thay iColor bằng con số cụ thể, ví dụ
Rng.Resize(i - fRow).Interior.ColorIndex = 36
và bỏ dòng lệnh xen kẻ màu
If iColor = 36 Then iColor = 37 Else iColor = 36

Cám ơn bác lắm luôn.