สอบถามวิธีการเติมสีเซลล์แนวดิ่งตามเงื่อนไขครับ

[naynum]

ขออนุญาตสอบถามแนวทางการเติมสีลงเซลล์แนวดิ่งโดยอ้างอิงสีจากเซลล์ที่กำหนดลงมา และหยุดเมื่อเจอสีอื่นกั้นไว้ แล้วข้ามไปเริ่มเติมสีเดิมต่อครับ ตามภาพแนบครับ



ตอนนี้ผมได้โค้ด VBA ให้มันเติมสีลงมาได้ครับ แต่มันไม่ข้ามสีส้มที่ใช้กั้นไว้ครับ มันทับสีส้มเลย
// โค้ดจาก AI ครับ ขอบคุณล่วงหน้าครับ

Code: Select all

Sub FillCellsVertically()
    Dim rng As Range
    Dim cell As Range
    Dim skipColors As Variant
    Dim counter As Integer
    ' Define the range to check
    Set rng = Range("A1:N20") ' Change this to your desired range
    ' Define the colors to skip (RGB color codes)
    skipColors = Array(RGB(255, 165, 0), RGB(255, 192, 0)) ' Add more colors to skip as needed
    ' Set the counter to zero
    counter = 0
    ' Loop through each cell in the range
    For Each cell In rng
        ' Check if the cell has a fill color
        If cell.Interior.Pattern <> xlNone Then
            ' Check if the fill color is not in the skip colors array
            If Not IsInArray(cell.Interior.Color, skipColors) Then
                ' Increment the counter
                counter = counter + 1
                ' Fill the current cell and the cells below it with the same color
                cell.Resize(rng.Rows.count - cell.Row + 1).Interior.Color = cell.Interior.Color
            End If
        End If
    Next cell
End Sub
Function IsInArray(val As Variant, arr As Variant) As Boolean
    Dim element As Variant
    For Each element In arr
        If val = element Then
            IsInArray = True
            Exit Function
        End If
    Next element
    IsInArray = False
End Function

[naynum]

ทำได้แล้วครับ เปลี่ยนจากข้ามสีที่คั่นไว้ เป็นเติมสีทุกจำนวนเซลล์ที่กำหนดแทน

Code: Select all

Sub FillCellsVertically()
    Dim rng As Range
    Dim cell As Range
    
    ' Define the range to check
    Set rng = Range("A1:N20") ' Change this to your desired range
    
    ' Loop through each cell in the range
    For Each cell In rng
        ' Check if the cell has a fill color
        If cell.Interior.Pattern <> xlNone Then
            ' Fill the current cell and the cells below it with the same color
            cell.Resize(rng.Rows.count - cell.Row + 1).Interior.Color = cell.Interior.Color
        End If
        ' Check if the current row is a multiple of 8
        If ((cell.Row + 1) - 1) Mod 8 = 0 Then
            ' Fill the current cell with orange color
            cell.Interior.Color = RGB(255, 165, 0)
        End If
    Next cell
End Sub