Tô màu các ô trong excel bằng VBA

[nhat_uct]

Nhờ các bác xem hộem. em có bào toán như vầy: em có một hàng các giá trị ( hàng 2). sau khi em nhập các giá trị các cột AvàB, em muốn ở hàng 2 giá trị nào nằm trong khoảng trị ở cột Avà B e vừa nhập sẽ bôi màu vàng. E viết đoạn code cơ mà có gì đó sai sai. Bác nào sử hộ e với.

 

[snow25]

Nhờ các bác xem hộem. em có bào toán như vầy: em có một hàng các giá trị ( hàng 2). sau khi em nhập các giá trị các cột AvàB, em muốn ở hàng 2 giá trị nào nằm trong khoảng trị ở cột Avà B e vừa nhập sẽ bôi màu vàng. E viết đoạn code cơ mà có gì đó sai sai. Bác nào sử hộ e với.
View attachment 208403

Đây bạn xem sửa theo code của bạn.

 

[Ba Tê]

Nhờ các bác xem hộ
Xem cái chỗ nào đây "Chời"!
Đoc cái tiêu đề muốn "hốt hền".

 

[nhat_uct]

Đây bạn xem sửa theo code của bạn.

Nó vẫn ko bôi màu đúng ý em bác à, tức là em muốn các giá trị không nằm trong khoảng em ko nhập ở cột A và B thì nó vẫn để trắng, ko bôi màu vàng, code

 

[snow25]

Nó vẫn ko bôi màu đúng ý em bác à, tức là em muốn các giá trị không nằm trong khoảng em ko nhập ở cột A và B thì nó vẫn để trắng, ko bôi màu vàng, code

Bạn gửi file lên xem nào.Khi đã sửa code ây.

 

[nhat_uct]

Bạn gửi file lên xem nào.Khi đã sửa code ây.

Vâng bác, nó đây ạ

 

[nhat_uct]

Vâng bác, nó đây ạ

tức ý em là em nhập ở cột A và B giả sử : 1-3; 9-13 thì chỉ các ô có giá trị bằng 1,3,9,11,13 được bôi vàng

Bài đã được tự động gộp: 27/11/18

Bạn gửi file lên xem nào.Khi đã sửa code ây.

File đây bác. Ý của em là khi em nhập ở cột A và B là 1-3;9-13 thì chỉ có các ô có giá trị 1,3,9,11,13 được bôi vàng

 

[CHAOQUAY]

@nhat_uct
Thử code này xem sao bạn

Sub tn_()
Dim i, j, k, x
Dim SArr()
With Sheet1
    .UsedRange.Interior.ColorIndex = xlNone
    x = .Range("b1000000").End(xlUp).Row
    For Each k In .Range("a3", .Range("b1000000").End(xlUp))
        If j < k Then j = k
    Next k
    k = j
    ReDim SArr(k)
    For i = 3 To x
        For j = .Range("a" & i) To .Range("b" & i)
            SArr(j) = 1
        Next j
    Next i
    For j = 3 To 30
        If .Cells(2, j).Value <= k Then
            If SArr(.Cells(2, j).Value) = 1 Then .Cells(2, j).Interior.ColorIndex = 6
        End If
    Next j
End With
End Sub

Bài đã được tự động gộp: 27/11/18

https://www.giaiphapexcel.com/diendân/help/terms/

Ai sẽ cố tình viết bài tiếp nào?

Hình như mọi thứ vẫn bình thường bác ạ

 

[♫ђöล♥ßล†♥†µ♫]

Em viết được cái này nhìn phát gớm luôn

Sub Boimau()
    Dim tArr, sArr, I As Long, J As Long, DK As Boolean: DK = False
    Dim Dic As Object, rng As Range, sRng As Range, R As Long
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("Sheet1")
        tArr = .Range("A3", .Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
        For I = 1 To UBound(tArr, 1)
            For J = tArr(I, 1) To tArr(I, 2)
                Dic.Item(J) = J
            Next J
        Next I
        Set sRng = .Range("C1", .Range("C" & Rows.Count).End(xlUp)).Resize(, 28)
        sRng.Interior.ColorIndex = xlNone
        sArr = sRng.Value
        For I = 2 To UBound(sArr, 1)
            For J = 1 To UBound(sArr, 2)
                R = Dic.Item(sArr(I, J))
                If R > 0 Then
                    DK = True
                    If rng Is Nothing Then
                        Set rng = .Cells(I, J + 2)
                    Else
                        Set rng = Union(rng, .Cells(I, J + 2))
                    End If
                End If
            Next J
        Next I
        If DK = True Then rng.Interior.ColorIndex = 6
    End With
    Set Dic = Nothing
End Sub

 

[concogia]

Với dữ liệu kiểu này, cột B luôn lớn hơn cột A
Thử em này:

Public Sub ToTo()
    Dim Vung, Tam, I, J, Bang, Cll
    Vung = Range([A3], [A5000].End(xlUp)).Resize(, 2)
    Set Bang = Range([C2], [C2].End(xlToRight))
        For I = 1 To UBound(Vung)
            For J = Vung(I, 1) To Vung(I, 2)
                Tam = Tam & " " & J & " "
            Next J
        Next I
    Bang.Interior.ColorIndex = xlNone
    For Each Cll In Bang
        If InStr(Tam, " " & Cll & " ") Then Cll.Interior.ColorIndex = 6
    Next Cll
End Sub

Thân

 

[CHAOQUAY]

Em viết được cái này nhìn phát gớm luôn

Có lẽ đổi hai dòng này

R = Dic.Item(sArr(I, J))
If R > 0 Then

Thành thế này cũng chạy được thì phải

If Dic.exists(sArr(I, J)) Then

 

[SA_DQ]

Thêm 1 tham khảo rùa bò nè:

Sub MyColor()
 Dim GHd As Integer, GHt As Integer, J As Integer, Col As Integer, MyColor As Byte
 Dim Cls As Range, Rng As Range
 
 Set Rng = Range([C2], [C2].End(xlToRight))
 Rng.Interior.ColorIndex = xlNone:              MyColor = 34
 For Each Cls In Rng
    For J = 3 To [A3].End(xlDown).Row
        GHd = Cells(J, "A").Value:                  GHt = Cells(J, "B").Value
        If Cls.Value >= GHd And Cls.Value <= GHt Then
            MyColor = MyColor + 1:                  Cls.Interior.ColorIndex = MyColor
            If MyColor = 42 Then MyColor = 34
        End If
    Next J
 Next Cls
End Sub