Nối nhiều chuỗi trong excel

[ThuNghi]

Vậy mình đưa ra các dữ kiện thế này:
- Dữ liệu được bố trí cùng dòng hoặc cùng cột
- Trong vùng dữ liệu có thể có cell rỗng
Yêu cầu:
- Dùng VBA nối các cell lại với nhau bằng 1 dấu phân cách nào đó nhưng bỏ qua các cell rỗng
- Code VBA không dùng vòng lập
------------------------------------

Dùng cáh củ chuối xem sao.
Vậy mình dùng replace 2 lần
- Thay chr(10) = " "
- Dùng worksheetFunction.Trim
- Thay " =chr(10)

Function JoinText(ByVal SrcText)
Dim Temp
On Error GoTo Stp1
  With WorksheetFunction
    Temp = .Transpose(SrcText)
    GoTo Stp2
Stp1:
    Temp = .Transpose(.Transpose(SrcText))
Stp2:
    JoinText = Join(Temp, Chr(10))
  End With
  JoinText = Replace(JoinText, Chr(10), " ")
  JoinText = WorksheetFunction.Trim(JoinText)
  JoinText = Replace(JoinText, " ", Chr(10))
End Function

 

[Hai Lúa Miền Tây]

Dùng cáh củ chuối xem sao.
Vậy mình dùng replace 2 lần
- Thay chr(10) = " "
- Dùng worksheetFunction.Trim
- Thay " =chr(10)

Function JoinText(ByVal SrcText)
Dim Temp
On Error GoTo Stp1
  With WorksheetFunction
    Temp = .Transpose(SrcText)
    GoTo Stp2
Stp1:
    Temp = .Transpose(.Transpose(SrcText))
Stp2:
    JoinText = Join(Temp, Chr(10))
  End With
  JoinText = Replace(JoinText, Chr(10), " ")
  JoinText = WorksheetFunction.Trim(JoinText)
  JoinText = Replace(JoinText, " ", Chr(10))
End Function

Nó sẽ xuống dòng tất cả những khoản trắng anh à

 

[ThuNghi]

Nó sẽ xuống dòng tất cả những khoản trắng anh à

Thấy nó bỏ các khoản trắng mà. Chắc chưa kéo độ cáo của cell lại.

 

[ndu96081631]

Dùng cáh củ chuối xem sao.
Vậy mình dùng replace 2 lần
- Thay chr(10) = " "
- Dùng worksheetFunction.Trim
- Thay " =chr(10)

Function JoinText(ByVal SrcText)
Dim Temp
On Error GoTo Stp1
  With WorksheetFunction
    Temp = .Transpose(SrcText)
    GoTo Stp2
Stp1:
    Temp = .Transpose(.Transpose(SrcText))
Stp2:
    JoinText = Join(Temp, Chr(10))
  End With
  JoinText = Replace(JoinText, Chr(10), " ")
  JoinText = WorksheetFunction.Trim(JoinText)
  JoinText = Replace(JoinText, " ", Chr(10))
End Function

Nếu 1 cell chỉ chứa 1 từ đơn thì OK
Nếu cell chứa tên 1 người thì sao? Tức bản thân dữ liệu cell ấy cũng có khoảng trắng
Ví dụ:
A1 = Trần Thanh
A2 Rỗng
A3 = Nguyễn Vũ
---------
Bài này đã từng làm rồi, đại khái ta sẽ:
- Thay khoảng trắng thành gì gì đó trước
- Thay Chr(10) thành khoảng trắng
- TRIM để cắt bỏ khoảng trắng thừa
- Thay khoảng trắng thành Chr(10)
- Thay gì gì đó thành khoảng trắng

 

[vidangtinhyeu99]

Nhờ các anh chị giúp em với khi em nối nhiều text ở các cell đến vài ngàn ký tự là nó bị mất một số nội dung ở các cell cuối cùng. Vậy có cách nào không. Xin chân thành cảm ơn sự quan tâm giúp đỡ. dùng hàm đã cho cũng không được

 

[vodoi2x]

Nếu 1 cell chỉ chứa 1 từ đơn thì OK

- Thay khoảng trắng thành gì gì đó trước

gì gì đó là gì, chắc nên thành thành - Dấu xuống dòng?

 

[ndu96081631]

gì gì đó là gì, chắc nên thành thành - Dấu xuống dòng?

Gì gì đó là bất cứ text nào, miễn sao bảo đảm nó không trùng với Text có sẳn ---> Thường thì tôi sẽ dùng các ký tự đặc biệt, chẳng hạn là vbBack

 

[vidangtinhyeu99]

Nhờ các anh chị giúp em với khi em nối nhiều text ở các cell đến vài ngàn ký tự là nó bị mất một số nội dung ở các cell cuối cùng. Vậy có cách nào không. Xin chân thành cảm ơn sự quan tâm giúp đỡ. dùng hàm đã cho cũng không được

oh Vậy có cách nào không. Xin chân thành cảm ơn sự quan tâm giúp đỡ. dùng hàm đã cho cũng không được

 

[Do Trong Hien]

Seo em mần hoài giống như các Bác chỉ trỏ mà nó cứ ra #Name? hoài là sao vậy ta? Hic! Bác nào mần hoàn chỉnh thì tải file lên cho cả nhà ngắm đi

 

[bobo2009]

cho hỏi để nối 2 ô 1 ô là text 1 ô là ngày tháng năm thì phải làm sao

 

[Hai Lúa Miền Tây]

cho hỏi để nối 2 ô 1 ô là text 1 ô là ngày tháng năm thì phải làm sao

Kết hợp hàm Text với dấu &

Ví dụ A1 là ngày 15/06/1977
A2 là 34

Công thức sẽ là:

=Text(A1,"dd/mm/yyyy") & " " & A2

 

[bebo021999]

cho hỏi để nối 2 ô 1 ô là text 1 ô là ngày tháng năm thì phải làm sao

Chào người anh em,
Nếu A1 chứa chuỗi, A2 chứa ngày tháng, tại A3 người anh em oánh vô:

=A1&TEXT(A2,"dd/mm/yyyy")

Tùy chọn kiểu ngày nhé.
Chúc người anh em thành công.

 

[TVAG]

Nó sẽ xuống dòng tất cả những khoản trắng anh à

Sao code không chạy vậy bạn

 

[TVAG]

Code không Chạy được

 

[chickenlove258]

Xin Chao Các Bạn, Mình gặp vấn đề giống bạn chủ topic, nhưng mình cần khi nối thành 1 cell với phân biệt là kí tự Char(10), thì định dạng Font cũng như size của text giữ nguyên như cell ban đầu. Điều này các Bạn giúp dùm...Thanks

 

[vst1986]

Trong ví dụ trên chỉ có 3 ô cần nối là Á, B1 và C1, có cách nào để nếu dữ liệu nhiều hơn mà mình không cần phải gõ công thức quá dài không mấy bac.

Cái này có thể viết hàm trong VBA để nối các ô trong 1 vùng chọn.Có thể nối dữ liệu ở 1 hàng hoặc 1 cột hoặc 1 vùng gồm cả hàng cả cột.

 

[namkpac]

nhờ mọi người giúp đỡ code vba nối dữ liệu trong 2 cell.

 

[nghiaphuc]

nhờ mọi người giúp đỡ code vba nối dữ liệu trong 2 cell.

VBA thì nó như thế này:
[GPECODE=vb]Sub NoiDuLieu()
Dim Tmp, Arr(), i As Long
Application.EnableEvents = False
Tmp = Sheet1.[F6:H1000]
ReDim Arr(1 To UBound(Tmp), 1 To 1)
For i = 1 To UBound(Tmp)
If Tmp(i, 1) > 0 Then Arr(i, 1) = Tmp(i, 2) & Tmp(i, 3)
Next
Sheet1.[D6].Resize(UBound(Tmp)) = Arr
Application.EnableEvents = True
End Sub[/GPECODE]
Trong code trên, 2 câu lệnh Application.EnableEvents = False và Application.EnableEvents = True nhằm tránh đụng chạm với Sub Worksheet_Change cho Sheet1 của bạn. Mà cái Sub Worksheet_Change của bạn có vấn đề, ai lại đi khai báo biến khơi khơi như vậy, nếu nằm ở dòng riêng thì tên biến phải đi sau từ khóa Dim, còn nếu không muốn Dim thì đưa nó lên dòng trên (đã có Dim) và phân cách bởi dấu phẩy với các biến phía trước.

 

[namkpac]

Em cảm ơn, em đã sửa lại code nhưng vấn đề là nếu cột F = 1 thì nối 2 chuỗi ký tự ở cột G và H không thì thoát. code anh chỉ em thêm vào chạy rồi và em sửa 1 xíu là tmp(i, 1) = 1 thay vì >1. thanks a nhiều

 

[namkpac]

VBA thì nó như thế này:
[GPECODE=vb]Sub NoiDuLieu()
Dim Tmp, Arr(), i As Long
Application.EnableEvents = False
Tmp = Sheet1.[F6:H1000]
ReDim Arr(1 To UBound(Tmp), 1 To 1)
For i = 1 To UBound(Tmp)
If Tmp(i, 1) > 0 Then Arr(i, 1) = Tmp(i, 2) & Tmp(i, 3)
Next
Sheet1.[D6].Resize(UBound(Tmp)) = Arr
Application.EnableEvents = True
End Sub[/GPECODE]
Trong code trên, 2 câu lệnh Application.EnableEvents = False và Application.EnableEvents = True nhằm tránh đụng chạm với Sub Worksheet_Change cho Sheet1 của bạn. Mà cái Sub Worksheet_Change của bạn có vấn đề, ai lại đi khai báo biến khơi khơi như vậy, nếu nằm ở dòng riêng thì tên biến phải đi sau từ khóa Dim, còn nếu không muốn Dim thì đưa nó lên dòng trên (đã có Dim) và phân cách bởi dấu phẩy với các biến phía trước.

xem giúp em đoạn code này với, ko biết nó sai chỗ nào nhưng em thử trên 1 file khác thì nó nối 2 chuỗi ok.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range, Rng As Range
If Target.Column <> 3 And Target.Column <> 10 And Target.Column <> 23 Then Exit Sub
For Each Cll In Intersect(Target, [C:C,J:J])
If Cll = "" Then
Cll.Offset(, IIf(Cll.Column = 3, -2, -1)).ClearContents
Cll.Offset(, IIf(Cll.Column = 23, -2, 0)).ClearContents
Else
If Cll.Column = 3 Then
Cll.Offset(, -1) = UCase(Left(Target, 2))
End If
'If Len(Cll.Offset(, -1)) < 1 Then Exit Sub
If Cll.Offset(, -1) = "PT" Then
Cll.Offset(, -2) = 3
ElseIf Cll.Offset(, -1) = "CT" Then
Cll.Offset(, -2) = 1
ElseIf Cll.Offset(, -1) = "GR" Then
Cll.Offset(, -2) = 2
ElseIf Cll.Offset(, -1) = "TT" Then
Cll.Offset(, -2) = 4
ElseIf Cll.Offset(, -1) = "PC" Then
Cll.Offset(, -2) = 9
End If
If Cll.Column = 10 Then
Set Rng = K02.[A:A].Find(Cll, LookAt:=xlWhole)
If Rng Is Nothing Then
Cll.Offset(, 12).ClearContents
Else
Cll.Offset(, 12) = Rng.Offset(, 2)
End If

End If
If Cll.Column = 23 Then
Cll.Offset(, -2) = Cll.Offset(, -9) & Cll.Offset(, -1)
End If
End If
Next
End Sub

chỉ có đoạn tại
If Cll.Column = 23 Then
Cll.Offset(, -2) = Cll.Offset(, -9) & Cll.Offset(, -1)
End If
thì 2 chuỗi ko hiển thị nối với nhau; các chỗ khác đều chạy tốt nhờ các anh chị trên diễn đàn giúp với.