Chuyễn MÀU SẮC thành SỐ! (1 người xem)

[anhtuan1066]

Lâu rồi tôi nhớ có lần các bạn nói về các hàm liên quan đến Color.. tôi cũng có tham gia mà giờ tìm hoài ko dc...
Tôi gữi file này nhờ các cao thủ giúp cách chuyển màu sắc thành số... Chi tiết tôi nêu trong file ấy
ANH TUẤN

 

[Mr Okebab]

Lâu rồi tôi nhớ có lần các bạn nói về các hàm liên quan đến Color.. tôi cũng có tham gia mà giờ tìm hoài ko dc...
Tôi gữi file này nhờ các cao thủ giúp cách chuyển màu sắc thành số... Chi tiết tôi nêu trong file ấy
ANH TUẤN

Cái này viết một UF sử dụng chỉ số của .Interior.ColorIndex = i là đươc thôi mà bác.

VD :

Function OB(Vung As Range) As String
    Dim Ma As Range
    For Each Ma In Vung
        OB = OB & Ma.Interior.ColorIndex
    Next
    Set Ma = Nothing
    Set Vung = Nothing
End Function

Thân!

 

[anhtuan1066]

Cái chính là tôi mất tiêu cái UDF ấy rồi... Bảo tôi tự làm nó thì thà chết còn hơn... Bắp có thì gữi lên tôi nghiên cứu thử...
Ha... ha... Bảo rằng "Lên nóc nhà uh? Cứ bắt thang mà lên"... Tôi ko có cái thang thì lấy gì mà bắt đây! Vả lại cũng ko biết tự làm ra cái thang ấy... Thế mới nhờ...
Giúp cho trót luôn Bắp ơi!
ANH TUẤN

 

[Mr Okebab]

Cái chính là tôi mất tiêu cái UDF ấy rồi... Bảo tôi tự làm nó thì thà chết còn hơn... Bắp có thì gữi lên tôi nghiên cứu thử...
Ha... ha... Bảo rằng "Lên nóc nhà uh? Cứ bắt thang mà lên"... Tôi ko có cái thang thì lấy gì mà bắt đây! Vả lại cũng ko biết tự làm ra cái thang ấy... Thế mới nhờ...
Giúp cho trót luôn Bắp ơi!
ANH TUẤN

Bác xem nhé, em đổi luôn ra number luôn rồi.

Option Explicit
Function OB(Vung As Range) As Double
    Dim Ma As Range
    Dim i As String
    For Each Ma In Vung
        i = i & Ma.Interior.ColorIndex
    Next
    OB = CDbl(i)
    Set Ma = Nothing
    Set Vung = Nothing
End Function

Thân!

 

[SoiBien]

Có thể có trường hợp người ta nhập không đúng màu, để code này thì nó tính ra một cái điện trở khác thì nguy, nên em xin phép thêm một dòng code này, vị trí chữ N sẽ chỉ ra màu nào bị sai, bác sửa lại hộ em nhé.

[COLOR=darkblue]Function[/COLOR] GetOmegaColor(Vung [COLOR=darkblue]As[/COLOR] Range, colordefine [COLOR=darkblue]As[/COLOR] Range) [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] cell [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] strOmega [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] cell [COLOR=darkblue]In[/COLOR] Vung
        strOmega = strOmega & getindexcolor(cell.Address, colordefine)
    [COLOR=darkblue]Next[/COLOR]
    GetOmegaColor = strOmega
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Function[/COLOR]
[COLOR=darkblue]Function[/COLOR] getindexcolor(cell [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], colordefine As Range)
    [COLOR=darkblue]For[/COLOR] i = 1 [COLOR=darkblue]To[/COLOR] colordefine.Columns.Count
        [COLOR=darkblue]If[/COLOR] Range(cell).Interior.ColorIndex = Range(Range("colordefine").Cells(1, i).Address).Interior.ColorIndex [COLOR=darkblue]Then[/COLOR]
            getindexcolor = colordefine.Cells(2, i).Value
            [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]For[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
[B][COLOR=red]    getindexcolor = "N"[/COLOR][/B]
    [COLOR=darkblue]Next[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Function[/COLOR]

Paste nó vào module rồi bác dùng thôi

 

[anhtuan1066]

Chính xác như Soibien nói... Ông này bộ có làm về điện tử ko sao biết rành thế nhỉ
Thanks cả 2 người nhé!
ANH TUẤN

 

[SA_DQ]

Hãy tìm; & nêu 1 í tưởng

Lâu rồi tôi nhớ có lần các bạn nói về các hàm liên quan đến Color.. tôi cũng có tham gia mà giờ tìm hoài ko dc...

Bạn tìm với từ khóa 'ColORS' lại xem sao;
To ~ ai quan tâm:
Mình cho rằng để khỏi chọn sai màu thì có thể bấm trực tiệp lên 1 trong ~ ô màu chuẩn trên B1:K1
/(hi đó số biểu thị màu sẽ hiện đâu đó cho ta, VD B3:E3;
Trong đó B3: biểu thị số thứ nhất; C3 số thứ 2;
D3: Phần đặc tính (người ta hay gọi nó vậy hay sao í!)
E3: Sai số có thể (?)

Chưa thử, chỉ mới là í tưởng; sẽ thực tiển nếu có người iêu cầu!

 

[anhtuan1066]

Bác ơi em có tìm rồi... nhưng hôm ấy gấp quá, lại tìm ko ra nên đưa luôn cho các cao thủ làm giùm... xem như lười ấy mà... hi... hi...
Cám ơn Bác
ANH TUẤN

 

[Mr Okebab]

Em hiểu rồi, như vậy là nó truy xuất trong vùng chọn sẵn.
Vậy thì bác xem nhé :

Option Explicit
Function OB(Vung As Range, DM As Range) As Double
    Dim Ma As Range
    Dim Ma2 As Range
    Dim i As String
    For Each Ma In Vung
        For Each Ma2 In DM
            If Ma.Interior.ColorIndex = Ma2.Interior.ColorIndex Then i = i & Ma2
    Next: Next
    
    OB = CDbl(i)
    Set Ma = Nothing
    Set Ma2 = Nothing
    Set Vung = Nothing
    Set DM = Nothing
End Function

Bác tham khảo :

Thân!

 

[Mr Okebab]

Chạy được không bác ????

 

[anhtuan1066]

Chạy được không bác ????

Oh... tất nhiên là dc rồi mới thanks chứ... hi... hi... một lần nữa cám ơn đại ca!
ANH TUẤN