Cần giúp hiện mỗi chữ số 1 màu trong cùng 1 ô

[ngoctuhpvn]

nhờ mọi người giúp!
Nếu qui định chữ số 1 là màu đỏ, 2 là màu xanh,..., số 9 màu vàng, số 0 màu tím. thì khi khi nhập số bất kỳ thì có màu tương ứng với chữ số đó.
ví dụ: khi nhập vào ô A1 số 1290 thì chữ số 1 có màu đỏ, 2 màu xanh, 9 màu vàng, 0 màu tím. tương tự nhập bất kỳ số nào vào các ô khác thì chữ số cũng tự động chuyển màu như vậy

 

[ndu96081631]

nhờ mọi người giúp!
Nếu qui định chữ số 1 là màu đỏ, 2 là màu xanh,..., số 9 màu vàng, số 0 màu tím. thì khi khi nhập số bất kỳ thì có màu tương ứng với chữ số đó.
ví dụ: khi nhập vào ô A1 số 1290 thì chữ số 1 có màu đỏ, 2 màu xanh, 9 màu vàng, 0 màu tím. tương tự nhập bất kỳ số nào vào các ô khác thì chữ số cũng tự động chuyển màu như vậy

Xin thưa: Hồng có cách nào làm được như vậy cả!
Với cell có dạng Text, người ta còn có thể dùng code VBA để định dạng cho từng ký tự, còn Number thì.. THUA

 

[ngoctuhpvn]

code VBA là như nào vậy bác. bác có thể nói rõ được không ạ

 

[ndu96081631]

code VBA là như nào vậy bác. bác có thể nói rõ được không ạ

Như tôi đã nói ở trên rồi còn gì: Dù là code VBA thì cũng không dùng được với dữ liệu dạng Number
Nói chung là yêu cầu của bạn không thể thực hiện được dù dùng bất cứ phương pháp gì

 

[mrlevisle]

thế bạn hướng dẫn dùng VBA cho text được không ?

 

[leonguyenz]

thế bạn hướng dẫn dùng VBA cho text được không ?

Tham khảo code tô màu từng số trong 1 ô, áp dụng cho số nằm trong Text:
[gpecode=vb]
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error Resume Next
Dim i As Byte, j As Byte
If Not Intersect(Range("A110"), Target) Is Nothing Then
If Len(Target) Then
For i = 1 To Len(Target)
For j = 0 To 9
If Mid(Target, i, 1) = j Then
Target.Characters(i, 1).Font.ColorIndex = j + 3
End If
Next j
Next i
End If
End If
Application.ScreenUpdating = True
End Sub
[/gpecode]

 

[Quang_Hải]

Tham khảo code tô màu từng số trong 1 ô, áp dụng cho số nằm trong Text:
[gpecode=vb]
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error Resume Next
Dim i As Byte, j As Byte
If Not Intersect(Range("A110"), Target) Is Nothing Then
If Len(Target) Then
For i = 1 To Len(Target)
For j = 0 To 9
If Mid(Target, i, 1) = j Then
Target.Characters(i, 1).Font.ColorIndex = j + 3
End If
Next j
Next i
End If
End If
Application.ScreenUpdating = True
End Sub
[/gpecode]

Dùng IsNumeric thì có thể bỏ 1 vòng For Next

 

[leonguyenz]

Dùng IsNumeric thì có thể bỏ 1 vòng For Next

Em chưa hiểu lắm, anh có thể gợi ý cho em với.

 

[Quang_Hải]

Em chưa hiểu lắm, anh có thể gợi ý cho em với.

Đại loại thế này

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Byte
If Not Intersect(Range("A1:D10"), Target) Is Nothing Then
   For i = 1 To Len(Target)
       If IsNumeric(Mid(Target, i, 1)) Then
           Target.Characters(i, 1).Font.ColorIndex = i
       End If
   Next i
End If
End Sub