Nhờ các bác viết code định dạng văn bản cho 1 phần dữ liệu trong ô

Liên hệ QC

trungtamcnc

Thành viên hoạt động
Tham gia
5/4/10
Bài viết
124
Được thích
9
Em có đoạn code tạo dữ liệu như sau:
For i = 3 To 8
Sheet1.Cells(i, j) = Arr3(i - 2) & "_" & Arr1(i - 2) & "_" & Arr2(i - 2)
Next i
Dữ liệu ở ô Sheet1.Cells(i, j) được tạo bởi 3 nguồn, cách nhau bởi dấu "_". Dữ liệu tạo ra co dạng như sau: 7.68_7.2_3.2 ạ. Nhờ các bác viết code giúp em với:
Phần 7.68 tô đậm, có màu đỏ; phần 7.2 có màu xanh; phần 3.2 có màu tím ạ.
Em cảm ơn nhiều.
 
Em có đoạn code tạo dữ liệu như sau:
For i = 3 To 8
Sheet1.Cells(i, j) = Arr3(i - 2) & "_" & Arr1(i - 2) & "_" & Arr2(i - 2)
Next i
Dữ liệu ở ô Sheet1.Cells(i, j) được tạo bởi 3 nguồn, cách nhau bởi dấu "_". Dữ liệu tạo ra co dạng như sau: 7.68_7.2_3.2 ạ. Nhờ các bác viết code giúp em với:
Phần 7.68 tô đậm, có màu đỏ; phần 7.2 có màu xanh; phần 3.2 có màu tím ạ.
Em cảm ơn nhiều.
bạn biết VBA nên, tôi lấy ví dụ này (cũng tìm kiếm trên mạng thôi), để bạn tham khảo và làm cho riêng bài cụ thể của bạn là xong
Mã:
Sub forRedText()

Dim i As Long
Dim text As String

text = Cells(1, 1).Value

For i = 1 To Len(text)
    If IsNumeric(Mid$(text, i, 1)) = True Then
        Cells(1, 1).Characters(i, 1).Font.Color = vbRed
    End If
Next

End Sub
 
Em có đoạn code tạo dữ liệu như sau:
For i = 3 To 8
Sheet1.Cells(i, j) = Arr3(i - 2) & "_" & Arr1(i - 2) & "_" & Arr2(i - 2)
Next i
Dữ liệu ở ô Sheet1.Cells(i, j) được tạo bởi 3 nguồn, cách nhau bởi dấu "_". Dữ liệu tạo ra co dạng như sau: 7.68_7.2_3.2 ạ. Nhờ các bác viết code giúp em với:
Phần 7.68 tô đậm, có màu đỏ; phần 7.2 có màu xanh; phần 3.2 có màu tím ạ.
Em cảm ơn nhiều.
Bạn chêm mấy dòng sau vào trong vòng lặp sau dòng Sheet1.Cells(i, j) = Arr3(i - 2) & "_" & Arr1(i - 2) & "_" & Arr2(i - 2)
Rich (BB code):
    Sheet1.Cells(i, j).Characters(1, Len(Arr3(i - 2))).Font.Bold = True
    Sheet1.Cells(i, j).Characters(1, Len(Arr3(i - 2))).Font.Color = vbRed
    Sheet1.Cells(i, j).Characters(Len(Arr3(i - 2)) + 2, Len(Arr1(i - 2))).Font.Color = vbBlue
    Sheet1.Cells(i, j).Characters(Len(Arr3(i - 2)) + Len(Arr1(i - 2)) + 3, Len(Arr2(i - 2))).Font.Color = -6750055

Nếu thấy Sheet1.Cells(i, j) lặp lại nhiều quá chướng mắt thì dùng With Sheet1.Cells(i, j) bọc lại nhé
 
Cái ni nhé bạn ơi.

PHP:
Option Explicit

Sub vidu()
    Call writeNewValueAndFormat(Sheet1.Range("A1"), "7.22218", "7.2", "3.2")

'Call writeNewValueAndFormat (Sheet1.Cells(i, j) , Arr3(i - 2) , Arr1(i - 2) , Arr2(i - 2) ) '
End Sub

Private Sub writeNewValueAndFormat(ByVal oCell As Range, _
                                  ByVal s1 As String, ByVal s2 As String, ByVal s3 As String, _
                                  Optional ByVal sDelim As String = "_")
    Dim s As String
    'Write new value '
    s = s1 & sDelim & s2 & sDelim & s3
    oCell.Value = s
    'Formatting... '
    oCell.Font.ColorIndex = xlAutomatic
    oCell.Characters(1, VBA.Len(s1)).Font.Bold = True
    oCell.Characters(1, VBA.Len(s1)).Font.Color = vbRed
    oCell.Characters(VBA.Len(s1 & sDelim) + VBA.Len(sDelim), VBA.Len(s2)).Font.Color = vbGreen
    oCell.Characters(VBA.Len(s) - VBA.Len(s2) + 1, VBA.Len(s2)).Font.Color = -6279056
End Sub
 
Bài trên mình viết sai dòng cuối
oCell.Characters(VBA.Len(s) - VBA.Len(s2) + 1, VBA.Len(s2)).Font.Color = -6279056

Sửa lại thành
oCell.Characters(VBA.Len(s) - VBA.Len(s3) + 1, VBA.Len(s3)).Font.Color = -6279056
 
Bài trên mình viết sai dòng cuối
oCell. Characters(VBA.Len(s) - VBA.Len(s2) + 1, VBA.Len(s2)).Font.Color = -6279056

Edit back to
oCell. Characters(VBA.Len(s) - VBA.Len(s3) + 1, VBA.Len(s3)).Font.Color = -6279056
Cảm ơn bạn. Mình mới thay biến để test, đổi màu được là ưng rồi. Có 3 bác trợ giúp, mỗi người mỗi hướng, đều hay cả.
 
Web KT
Back
Top Bottom