V/v: Code VBA tự bôi màu (1 người xem)

[GTK-PM]

Nhờ anh chị giúp đỡ cho em xin code VBA tự động bôi màu cho số phiếu lớn nhất ở file bên dưới.
+ Bôi màu theo điều kiện chữ HPN là số phiếu lớn nhất trong vùng B4 đến B54
+ Bôi màu theo điều kiện chữ XK là số phiếu lớn nhất trong vùng B4 đến B54

 

[ChanhTQ@]

Option Explicit
Sub BoiMau2MaxFieu()
 Dim J As Long, HPN As Long, XK As Long, W As Long
 Dim Arr()
 
 Arr() = Range([B4], [B4].End(xlDown)).Value
 For J = 9999 To 0 Step -1
    For W = 1 To UBound(Arr())
        If InStr(Arr(W, 1), "HPN" & Right("000" & CStr(J), 4)) Then
            HPN = W + 3:         GoTo GPE1
        End If
    Next W
 Next J
GPE1:            If HPN Then _
                    Cells(HPN, "B").Interior.ColorIndex = 38
For J = 9999 To 0 Step -1
    For W = 1 To UBound(Arr())
        If InStr(Arr(W, 1), "XK" & Right("000" & CStr(J), 4)) Then
            XK = W + 3:         GoTo GPE2
        End If
    Next W
 Next J
GPE2:            If XK Then _
                    Cells(XK, "B").Interior.ColorIndex = 35
End Sub

 

[GTK-PM]

Cảm ơn bạn Chanh TQ, bạn có thể giúp mình cho code này tự động bôi màu chứ không cần phải gán code vào From không?

 

[PacificPR]

Cho em góp vui 1 tý cho vui

Sub Boimau()
Dim i As Long, Erow As Long
Dim P As Long, PNMax As Long, PxMax As Long, Ixuat As Long, Inhap As Long
With Sheet1
Erow = .Range("B65535").End(3).Row
.Range("B4:B" & Erow).Interior.Color = xlNone
For i = 4 To Erow
P = Right(Application.WorksheetFunction.Substitute(.Range("B" & i), "/" & Format(Month(.Range("A" & i)), "00"), ""), 3)
If Left(Range("B" & i), 2) = "HP" Then
If PNMax < P Then PNMax = P: Inhap = i
End If
If Left(Range("B" & i), 2) = "XK" Then
If PxMax < P Then PxMax = P: Ixuat = i
End If
Next i
.Range("B" & Inhap).Interior.Color = 65535
.Range("B" & Ixuat).Interior.Color = 65535
End With
End Sub

 

[SA_DQ]

. . . Bạn có thể giúp mình cho code này tự động bôi màu chứ không cần phải gán code vào From không?

File bạn đâu có Form nào thì fải? Mà gán vô form để làm chi vậy?

- Nếu bạn cần tự động bôi màu khi nhập liệu thì áp dụng macro sự kiện trên cột [B:B]
- . . . .

 

[GTK-PM]

Nhờ HYen17 gán vào file giùm mình ! Cảm ơn bạn

 

[PacificPR]

Nhờ HYen17 gán vào file giùm mình ! Cảm ơn bạn

Bạn ghép nó vào sự kiện này xem sao

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Range("B4:B65536") Is Nothing Then
' Code cua ban
End If
End Sub

 

[SA_DQ]

Shabava36 giúp bạn í đi!

Mình fải thoát rồi!

 

[GTK-PM]

Cảm ơn các bạn, mình đã giải quyết được vấn đề.