Hỏi về cách chuyển chữ thường sang chữ nghiêng trong cung một chuỗi văn bản (5 người xem)

hpmongmanh · 23/9/10

Nối text từ các cell có định dạng khác nhau về cùng 1 cell

Mình có một vấn đề muốn xin được chỉ giáo :
VD :
Trong ô A1 gõ "Dân tộc" định dạng font in đậm, in nghiêng hoặc gạch chân ...
Trong ô A2 gõ "Việt Nam" định dạng font in thường
Trong ô A3 gõ "=A1&""&A2
Kết quả trả về "Dân tộc Việt Nam" nhưng lúc này chư "Dân tộc" lại in thường theo định dang của ô A3
Vì vậy mình muốn hỏi có làm cách nào để chuỗi ký tự trong ô A3 vừa có định dạng font của ô A1 và A2
Xin chân thành cảm ơn

Cảm ơn các bạn đã chỉ giáo! bây giờ mình xin được hỏi tiếp rất mong nhận được chỉ giáo sớm:
Nhập ký tự dạng text vào ô A1, A2, A3, ... (mỗi ô là một kiểu định dạng), tại ô C1 sẽ nối A1, A2, A3, ... thành 1 chuỗi (vẫn giữ nguyên định dạng từ các ô được nối). Yêu cầu khi nhập đến đâu thì hiển thị kết quả ngay đến đó, không dùng nút lệnh.
Một lần nữa cảm ơn!

MinhCong · 23/9/10

hpmongmanh đã viết:
Mình có một vấn đề muốn xin được chỉ giáo :
VD :
Trong ô A1 gõ "Dân tộc" định dạng font in đậm và in nghiêng
Trong ô A2 gõ "Việt Nam" định dạng font in thường
Trong ô A3 gõ "=A1&""&A2
Kết quả trả về "Dân tộc Việt Nam" nhưng lúc này chư "Dân tộc" lại in thường theo định dang của ô A3
Vì vậy mình muốn hỏi có làm cách nào để chuỗi ký tự trong ô A3 vừa có định dạng font của ô A1 và A2
Xin chân thành cảm ơn

Bạn dùng tạm củ chuối này vậy:

Mã:

Sub Noichu()
Dim i As Long, enR As Long
Range("C:C").Clear
enR = Sheet1.Range("A65536").End(xlUp).Row
 For i = 1 To enR
    With Cells(i, 3)
        .FormulaR1C1 = "=RC[-2]&"" ""&RC[-1]"
        .Value = .Value
    End With
    If Cells(i, 1) <> "" Then
      With Cells(i, 3).Characters(Start:=1, Length:=Len(Cells(i, 1))).Font
        .FontStyle = "Bold Italic"
      End With
    Else
    End If
 Next
End Sub

Xem thêm file nhé!

ndu96081631 · 23/9/10

MinhCong đã viết:

Bạn dùng tạm củ chuối này vậy:

Mã:

Sub Noichu()
Dim i As Long, enR As Long
Range("C:C").Clear
enR = Sheet1.Range("A65536").End(xlUp).Row
 For i = 1 To enR
    With Cells(i, 3)
        .FormulaR1C1 = "=RC[-2]&"" ""&RC[-1]"
        .Value = .Value
    End With
    If Cells(i, 1) <> "" Then
      With Cells(i, 3).Characters(Start:=1, Length:=Len(Cells(i, 1))).Font
        .FontStyle = "Bold Italic"
      End With
    Else
    End If
 Next
End Sub

Xem thêm file nhé!

Nếu viết thành code, MinhCong nên làm theo hướng thế này:
- Nối chuổi thành KQ
- Xét chuổi KQ, định dạng đoạn đầu giống như chang như cell thứ nhất và đoạn cuối giống y chang cell thứ 2
Có nghìa là 2 cell nguồn định dạng thế nào thì KQ cũng y thế

MinhCong · 23/9/10

ndu96081631 đã viết:
Nếu viết thành code, MinhCong nên làm theo hướng thế này:
- Nối chuổi thành KQ
- Xét chuổi KQ, định dạng đoạn đầu giống như chang như cell thứ nhất và đoạn cuối giống y chang cell thứ 2
Có nghìa là 2 cell nguồn định dạng thế nào thì KQ cũng y thế

Theo góp ý của Anh Em điều chỉnh lại code như sau. Anh xem góp ý thêm cho Em nhé!

Mã:

Sub Noichu()
Dim i As Long, enR As Long
Range("C:C").Clear
enR = Sheet1.Range("A65536").End(xlUp).Row
 For i = 1 To enR
    With Cells(i, 3)
        .FormulaR1C1 = "=RC[-2]&"" ""&RC[-1]"
        .Value = .Value
    End With
    If Cells(i, 1) <> "" Then
      With Cells(i, 3).Characters(Start:=1, Length:=Len(Cells(i, 1))).Font
         .FontStyle = Cells(i, 1).Font.FontStyle
         .ColorIndex = Cells(i, 1).Font.ColorIndex
      End With
      With Cells(i, 3).Characters(Start:=Len(Cells(i, 1)) + 2, Length:=Len(Cells(i, 2))).Font
         .FontStyle = Cells(i, 2).Font.FontStyle
         .ColorIndex = Cells(i, 2).Font.ColorIndex
      End With
    Else
      With Cells(i, 3).Characters(Start:=1, Length:=Len(Cells(i, 2)) + 1).Font
         .FontStyle = Cells(i, 2).Font.FontStyle
         .ColorIndex = Cells(i, 2).Font.ColorIndex
      End With
    End If
 Next
End Sub

ndu96081631 · 24/9/10

MinhCong đã viết:
Theo góp ý của Anh Em điều chỉnh lại code như sau. Anh xem góp ý thêm cho Em nhé!

Tôi thì viết vầy:

PHP:

Function JoinText(ByVal sRng As Range, ByVal Sep As String) As String
  On Error GoTo NextStp
  If sRng.Count = 1 Then JoinText = sRng.Value: Exit Function
  With WorksheetFunction
    JoinText = Join(.Transpose(sRng), Sep)
    Exit Function
NextStp:
    JoinText = Join(.Transpose(.Transpose(sRng)), Sep)
  End With
End Function

PHP:

Private Sub MergeStr(ByVal sRng As Range, ByVal Sep As String, ByVal Target As Range)
  Dim Clls As Range, st As Long, i As Long, ifnt As Font
  Target.Value = JoinText(sRng, Sep)
  For Each Clls In sRng
    For i = 1 To Len(Clls)
      With Target.Characters(st + i, 1).Font
        Set ifnt = Clls.Characters(i, 1).Font
        .FontStyle = ifnt.FontStyle
        .Name = ifnt.Name
        .ColorIndex = ifnt.ColorIndex
        .Size = ifnt.Size
        .Underline = ifnt.Underline
        .Strikethrough = ifnt.Strikethrough
        .Superscript = ifnt.Superscript
        .Subscript = ifnt.Subscript
      End With
    Next i
    st = st + Len(Clls) + Len(Sep)
  Next
End Sub

PHP:

Sub Main()
  Dim i As Long
  With Selection
    For i = 1 To .Rows.Count
      MergeStr Range(.Rows(i).Address), " ", .Offset(, .Columns.Count)(i, 1)
    Next
  End With
End Sub

Thử file đính kèm này xem thế nào nhé

mymapmap · 18/10/11

Cảm Ơn Bác ndu96081631 đã có code rất hay để hoc hỏi. Nhưng em nghi Bác có thể viết dưới dạng như một hàm trong excel được không? để e có thể gọi nó bất cứ chỗ nào không phải nhấn nút. gì nhu cầu của e chỉ có 2 cell thôi
VD: = NoiChuoi(A1:A2)
Xin Cảm ơn!

ndu96081631 · 18/10/11

mymapmap đã viết:
Cảm Ơn Bác ndu96081631 đã có code rất hay để hoc hỏi. Nhưng em nghi Bác có thể viết dưới dạng như một hàm trong excel được không? để e có thể gọi nó bất cứ chỗ nào không phải nhấn nút. gì nhu cầu của e chỉ có 2 cell thôi
VD: = NoiChuoi(A1:A2)
Xin Cảm ơn!

Không được đâu!
Bạn nên biết rằng:
- Hàm chỉ có chức năng tính toán và xuất ra 1 kết quả nào đó
- Hàm không có chức năng định dạng hoặc thay đổi thuộc tính của cell ---> Công việc này thích hợp với các THỦ TỤC (gọi là Sub)

chickenlove258 · 9/1/13

ndu96081631 đã viết:

Tôi thì viết vầy:

PHP:

Function JoinText(ByVal sRng As Range, ByVal Sep As String) As String
  On Error GoTo NextStp
  If sRng.Count = 1 Then JoinText = sRng.Value: Exit Function
  With WorksheetFunction
    JoinText = Join(.Transpose(sRng), Sep)
    Exit Function
NextStp:
    JoinText = Join(.Transpose(.Transpose(sRng)), Sep)
  End With
End Function

PHP:

Private Sub MergeStr(ByVal sRng As Range, ByVal Sep As String, ByVal Target As Range)
  Dim Clls As Range, st As Long, i As Long, ifnt As Font
  Target.Value = JoinText(sRng, Sep)
  For Each Clls In sRng
    For i = 1 To Len(Clls)
      With Target.Characters(st + i, 1).Font
        Set ifnt = Clls.Characters(i, 1).Font
        .FontStyle = ifnt.FontStyle
        .Name = ifnt.Name
        .ColorIndex = ifnt.ColorIndex
        .Size = ifnt.Size
        .Underline = ifnt.Underline
        .Strikethrough = ifnt.Strikethrough
        .Superscript = ifnt.Superscript
        .Subscript = ifnt.Subscript
      End With
    Next i
    st = st + Len(Clls) + Len(Sep)
  Next
End Sub

PHP:

Sub Main()
  Dim i As Long
  With Selection
    For i = 1 To .Rows.Count
      MergeStr Range(.Rows(i).Address), " ", .Offset(, .Columns.Count)(i, 1)
    Next
  End With
End Sub

Thử file đính kèm này xem thế nào nhé

Xin Chào Bác NDU, Cũng với code của Bác nhưng em muốn thay thế khoảng trắng bằng kí tự Char(10) thì cần cân chỉnh gì ạ, em đạ thử nhiều lần với vốn kiến thức ít ỏi của em mà cũng chưa được. Nay mạo muo5i nhờ Bác giúp thêm chút nữa.

ndu96081631 · 22/1/15

chickenlove258 đã viết:
Xin Chào Bác NDU, Cũng với code của Bác nhưng em muốn thay thế khoảng trắng bằng kí tự Char(10) thì cần cân chỉnh gì ạ, em đạ thử nhiều lần với vốn kiến thức ít ỏi của em mà cũng chưa được. Nay mạo muo5i nhờ Bác giúp thêm chút nữa.

Cú pháp của Sub MergeStr là:
MergeStr (vùng dữ liệu, dấu phân cách, nơi đặt kết quả)
Vậy Char(10) của bạn là đặt vào chỗ màu đỏ ấy, tức khi áp dụng vào Sub Main ta sẽ viết

Mã:

Sub Main()
  Dim i As Long
  With Selection
    For i = 1 To .Rows.Count
      MergeStr Range(.Rows(i).Address), [COLOR=#ff0000]Chr(10)[/COLOR], .Offset(, .Columns.Count)(i, 1)
    Next
  End With
End Sub

Lưu ý: Trên bảng tính ta viết Char(10) còn trong VBA thì viết Chr(10) nha (không có chữ a)

autokiss · 29/1/15

Code nối chữ hay quá!

Hỏi về cách chuyển chữ thường sang chữ nghiêng trong cung một chuỗi văn bản (5 người xem)

Người dùng đang xem chủ đề này

hpmongmanh

Thành viên mới

MinhCong

Thành viên gắn bó

File đính kèm

ndu96081631

Huyền thoại GPE

MinhCong

Thành viên gắn bó

File đính kèm

ndu96081631

Huyền thoại GPE

File đính kèm

mymapmap

Thành viên hoạt động

ndu96081631

Huyền thoại GPE

chickenlove258

Thành viên mới

ndu96081631

Huyền thoại GPE

autokiss

Thành viên hoạt động

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian