Nối nhiều chuỗi trong excel

Blue Softs Liên hệ QC

ThuNghi

Hãy cho rồi sẽ nhận!
Thành viên danh dự
Tham gia
16/8/06
Bài viết
3,814
Được thích
4,458
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)
PHP:
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

❆❆❆❆❆❆❆❆
Thành viên BQT
Administrator
Tham gia
18/3/08
Bài viết
8,136
Được thích
15,432
Giới tính
Nam
Nghề nghiệp
Làm ruộng.
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)
PHP:
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 à
 

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia
5/6/08
Bài viết
30,720
Được thích
53,695
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)
PHP:
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
 
Lần chỉnh sửa cuối:

vidangtinhyeu99

Thành viên mới
Tham gia
1/10/07
Bài viết
28
Được thích
1
Nghề nghiệp
sinh vien
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
 

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia
5/6/08
Bài viết
30,720
Được thích
53,695
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

Thành viên mới
Tham gia
1/10/07
Bài viết
28
Được thích
1
Nghề nghiệp
sinh vien
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

Thành viên mới
Tham gia
25/6/08
Bài viết
10
Được thích
2
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

Thành viên mới
Tham gia
31/5/10
Bài viết
6
Được thích
4
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

❆❆❆❆❆❆❆❆
Thành viên BQT
Administrator
Tham gia
18/3/08
Bài viết
8,136
Được thích
15,432
Giới tính
Nam
Nghề nghiệp
Làm ruộng.

bebo021999

Thành viên gạo cội
Tham gia
26/1/11
Bài viết
4,235
Được thích
6,563
Giới tính
Nam
Nghề nghiệp
GPE
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ô:
Mã:
=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

Thành viên mới
Tham gia
27/9/12
Bài viết
6
Được thích
0
Code không Chạy được
 

chickenlove258

Thành viên mới
Tham gia
8/1/12
Bài viết
18
Được thích
2
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

Thành viên mới
Tham gia
10/12/09
Bài viết
8
Được thích
1
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

Thành viên thường trực
Tham gia
25/11/08
Bài viết
279
Được thích
9
nhờ mọi người giúp đỡ code vba nối dữ liệu trong 2 cell.
 

File đính kèm

  • Hoi ham if.xls
    31 KB · Đọc: 27

nghiaphuc

Thành viên gạo cội
Thành viên danh dự
Tham gia
25/9/09
Bài viết
5,732
Được thích
8,831
Giới tính
Nam
Nghề nghiệp
Giáo viên
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 = FalseApplication.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

Thành viên thường trực
Tham gia
25/11/08
Bài viết
279
Được thích
9
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
 
Lần chỉnh sửa cuối:

namkpac

Thành viên thường trực
Tham gia
25/11/08
Bài viết
279
Được thích
9
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 = FalseApplication.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.
 
Top Bottom