Snasui Excel Forum

... lastRow + 3).Merge
ws.Range("A" & lastRow + 3).Value = "รวมทั้งสิ้น"

' ตั้งค่าสีพื้นหลัง
ws.Range("A" & lastRow + 3 & ":D" & lastRow + 3).Interior.Color = RGB(102, 255, 51) ' สี #C6EFCE

' จัดตำแหน่งให้ข้อความอยู่ตรงกลาง
ws.Range("A" & lastRow + 3).HorizontalAlignment = xlCenter
ws.Range ...

... x = 100000
With Worksheets(1)
Set rall = .Range("E2:E1000,H2:H1000,K2:K1000,N2:N1000,Q2:Q1000,T2:T1000,W2:W1000,Z2:Z1000,AC2:AC1000,")
rall.Interior.Color = xlNone

For Each r In rall
If Not IsEmpty(r.Value) Then
strVal = Sort0(Format(r.Value, "000"))
If Not d.Exists(strVal) Then
d.Add ...

... x = 100000
With Worksheets(1)
Set rall = .Range("E2:E1000,H2:H1000,K2:K1000,N2:N1000,Q2:Q1000,T2:T1000,W2:W1000,Z2:Z1000,AC2:AC1000,")
rall.Interior.Color = xlNone

For Each r In rall
If Not IsEmpty(r.Value) Then
strVal = Sort0(Format(r.Value, "000"))
If Not d.Exists(strVal) Then
d.Add ...

... ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
x = 100000
With Worksheets(1)
Set rall = .Range("a2:q30,a32:q59")
rall.Interior.Color = xlNone

For Each r In rall
If Not IsEmpty(r.Value) Then
strVal = Sort0(r.Value)
If Not d.Exists(strVal) Then
d.Add key:=strVal, Item ...

... rng

Set dict = CreateObject("Scripting.Dictionary")
colorIndex = 3 ' Start coloring from color index 3

' Clear existing colors
fullRange.Interior.ColorIndex = xlNone

' Loop through each cell in the combined range
For Each cell In fullRange
If cell.Value > 0 Then ' Only consider positive ...

... Range("aq" & itme & ":aq10000")
If r.Value <> "" And r.Value <= 0 Then 'เงื่อนไข ไม่เป็นค่าว่าง และ มีค่าน้อยกว่า 0 หรือเท่ากับ 0

r.EntireRow.Interior.Color = vbCyan 'ใส่สีฟ้าเฉพาะแถวที่ตรงกับเงื่อนไข

End If
Next r
End With

End With
End If
Next sh

Application.DisplayAlerts = True ...

... Range("a1:a10000"), 0)
' otme = Application.Match("OutTime", .Range("a1:a10000"), 0)

' If (sh.Range("aq" & itme & ":aq" & otme)) <= 0 Then .Interior.Color = vbCyan
For Each r In .Range("aq" & itme & ":aq1000")
If r.Value <> "" And r.Value <= 0 Then
r.Interior.Color = vbCyan
End If
Next r ...

... Match("InTime", .Range("a1:a10000"), 0)
otme = Application.Match("OutTime", .Range("a1:a10000"), 0)

If (sh.Range("aq" & itme & ":aq" & otme)) <= 0 Then .Interior.Color = vbCyan

End With

End With
End If

Next sh

'Application.DisplayAlerts = True

Worksheets("Main").Activate

End Sub

... itme = Application.Match("InTime", .Range("a1:a10000"), 0)
otme = Application.Match("OutTime", .Range("a1:a1000"), 0)

If itme.Range("AQ10:AQ").Value = 0 Then Interior.Color = vbYellow

End With
End With
End If
Next sh
'Application.DisplayAlerts = True
Worksheets("Main").Activate
End Sub

... itme = Application.Match("InTime", .Range("a1:a10000"), 0)
otme = Application.Match("OutTime", .Range("a1:a1000"), 0)

If itme.Range("AQ10:AQ").Value = 0 Then Interior.Color = vbYellow

End With
End With
End If
Next sh
'Application.DisplayAlerts = True
Worksheets("Main").Activate
End Sub

... 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 ...

... 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 ...

... r, 17)) = "" Or Trim(Cells(r, 18)) = "" Then
'Do Notning
If Trim(Cells(r, 14)) = "" Then
Cells(r, 14).Borders.Color = vbBlack

Cells(r, 14).Interior.Color = vbRed
End If
If Trim(Cells(r, 15)) = "" Then
Cells(r, 15).Borders.Color = vbBlack
Cells(r, 15).Interior.Color = RGB(205, 205, 180 ...

... Dim lr As Long, r As Range
lr = Range("H" & Rows.Count).End(xlUp).Row
For Each r In ActiveSheet.Range("H3:H" & lr)
If Len(r.Value) < 5 Then
r.Interior.Color = vbYellow
End If
Next r
Range("aj2").Formula = "=len(h4)<5"
Range("a4").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace ...

... ActiveSheet.Range("$A$3:$AG$100000").AutoFilter Field:=8 'ºÃ÷Ѵ·Õèà¾ÔèÁà¢éÒÁÒà¾×èÍãËéáÊ´§à©¾ÒТéÍÁÙÅ·Õèµéͧ¡ÒÃ
If Len(r.Value) < 5 Then
r.Interior.Color = vbYellow
End If
Next r
Range("aj2").Formula = "=len(h4)<5"
Range("a4").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace ...

... ActiveSheet.Range("$A$3:$AG$100000").AutoFilter Field:=8 'ºÃ÷Ѵ·Õèà¾ÔèÁà¢éÒÁÒà¾×èÍãËéáÊ´§à©¾ÒТéÍÁÙÅ·Õèµéͧ¡ÒÃ
If Len(r.Value) < 5 Then
r.Interior.Color = vbYellow
End If
Next r
Range("aj2").Formula = "=len(h4)<5"
Range("a4").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace ...

... Rows.Count).End(xlUp).Row
For Each r In ActiveSheet.Range("H3:H" & lr)
ActiveSheet.Range("$A$3:$AG$100000").AutoFilter Field:=8 'บรรทัดที่เพิ่มเข้ามาเพื่อให้แสดงเฉพาะข้อมูลที่ต้องการ
If Len(r.Value) < 5 Then
r.Interior.Color = vbYellow
End If
Next r
Range("H4").Activate
End Sub


ขอบพระคุณครับ

... Click()
Dim lr As Long, r As Range
lr = Range("H" & Rows.Count).End(xlUp).Row
For Each r In ActiveSheet.Range("H3:H" & lr)
If Len(r.Value) < 5 Then
r.Interior.Color = vbYellow
End If
Next r
End Sub


อาจารย์ครับถ้าต้องการให้แสดงเฉพาะข้อมูลที่ต้องตามเงื่อนไข ต้องเขียนใส่ fillter ยังไงครับ

:D ตัวอย่างการปรับ Code ครับ

Private Sub LenHN_Click()
Dim lr As Long, r As Range
lr = Range("H" & Rows.Count).End(xlUp).Row
For Each r In ActiveSheet.Range("H3:H" & lr)
If Len(r.Value) < 5 Then
r.Interior.Color = vbYellow
End If
Next r
End Sub

... LenHN_Click()
Dim lr As Long
lr = Range("H" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("$H$3:$H$100000").AutoFilter Field:=8, Criteria1:= _
"<?????", Operator:=xlAnd
Range("H3:H" & lr).SpecialCells(xlCellTypeVisible).Interior.Color = vbYellow
End Sub


ขอความกรุณาแนะนำด้วยครับ ขอบพระคุณครับ