Nối chuỗi từ 2 cell thành 1 cell và được phân biệt bằng kí tự CHAR(10) (2 người xem)

[chickenlove258]

Xin chào các Quý Thấy cô cùng toàn thể bạn hữu trên diễn đàn...
Như yêu câu của tiêu đề " Nối chuỗi từ 2 cell thành 1 cell và được phân biệt bằng kí tự CHAR(10) ", nhưng có thêm yêu cầu giữ nguyên được định dạng (Font, size ) như ban đầu của 2 cell sau khi ghép.

Mình tham khảo điễn đàn có xem qua bài của Thầy NDU

http://www.giaiphapexcel.com/forum/...sang-ch?-nghiêng-trong-cung-m?t-chu?i-van-b?n

Thầy NDu có đoạn code như bên dưới, đoạn này làm việc rất tốt gần giống với yêu cầu của mình chỉ khác là khoảng trắng là điểm phân biệt 2 chuỗi của 2 cell ban đâu.... Nay xin chì giáo thêm cách chỉnh sửa thay khoảng trắng bằng kí tự CHAR(10) để cell sau khi nối hiển thị sự phân biệt giữa 2 cell đầu bằng kí tự xuống hàng...


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 Code:
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 Code:
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


Chân thành cảm ơn các bạn đạ xem qua bài toán nho nhỏ của mình, Đặc biệt là Thấy ndu96081631

 

[ndu96081631]

Thầy NDu có đoạn code như bên dưới, đoạn này làm việc rất tốt gần giống với yêu cầu của mình chỉ khác là khoảng trắng là điểm phân biệt 2 chuỗi của 2 cell ban đâu.... Nay xin chì giáo thêm cách chỉnh sửa thay khoảng trắng bằng kí tự CHAR(10) để cell sau khi nối hiển thị sự phân biệt giữa 2 cell đầu bằng kí tự xuống hàng...

Cái biến Sep as String trong code chính là dấu phân cách đấy! Khi áp dụng, ta cho Sep = Chr(10) là được rồi
Ví dụ: MergeStr Range(.Rows(i).Address), Chr(10), .Offset(, .Columns.Count)(i, 1)

 

[chickenlove258]

Thật sự cám ơn Thầy, em mắc phải lỗi sơ đẳng quá, em thấy doạn code chỉ cần thay biến chỗ khoảng trắng mà đã đổi màu đỏ, nhưng lại thêm 1 khoảng trắng nên đoạn code không hoàn thành, cứ báo lỗi...

MergeStr Range(.Rows(i).Address), Chr(10)_, .Offset(, .Columns.Count)(i, 1)

Xin cảm ơn Thầy lần nữa và nhắc nhở các bạn xem qua chớ mắc cái lỗi tào lao như mình nhé...