Có thể dùng hàm Join để nối chuối từ các cell lại không?
Trong bài viết này:
https://www.giaiphapexcel.com/forum/showthread.php?t=18360
Bạn Rollover79 có ý kiến cho rằng:Theo em thì bác nên nhập tất cả vào 1 ô, các ký tự ngăn cách nhau bởi 1 ký tự nào đó, rồi Split nó ra là ok thôi. Còn cái vụ ghép vào, nếu là mảng 1 chiều thì có thể dùng Join mà ko cần phải dùng vòng lặp For.
Vậy nếu như tôi có dử liệu:
A1 = A
A2 = B
A3 = C
A4 = D
Tôi đặt:
Set Rng = Range("A1:A4")
Đương nhiên Rng phải là mảng 1 chiều rồi
Vậy xin hỏi có thể dùng hàm Join để nối tất cả các phần tử của Rng lại với nhau để được kết quả A,B,C,D mà không cần bất cứ vòng lập nào không?
Tôi đã thử nhiều lần… đã tìm nhiều nơi… nhưng hầu hết người ta đều dùng vòng lập (mà nếu đã dùng vòng lập thì cần gì đến hàm Join nhỉ?)
Ah… tôi biết cách làm rồi —> Thông qua hàm TRANSPOSE
Function JoinText(Vung As Range, Optional PC As String = ", ") As String
On Error GoTo Tiep
With Application.WorksheetFunction
JoinText = Join(.Transpose(Vung), PC)
Exit Function
Tiep:
JoinText = Join(.Transpose(.Transpose(Vung)), PC)
End With
End Function
UDF này cho phép nối các cell từ 1 dòng hoặc 1 cột mà không cần bất cứ vòng lập nào
Với dử liệu là 1 vùng gồm nhiều dòng nhiều cột, các bạn hãy phát triển tiếp bằng cách quét từ 1 đến tổng số dòng (hoặc từ 1 đến tổng số cột —> Tùy theo số dòng ít hơn hay số cột ít hơn) —> Như vậy tốc độ sẽ nhanh hơn gấp nhiều lần so với phương pháp quét qua từng cell
Trải nghiệm xem!
www.giaiphapexcel.com/diendan/threads/c%C3%B3-th%E1%BB%83-d%C3%B9ng-h%C3%A0m-join-%C4%91%E1%BB%83-n%E1%BB%91i-chu%E1%BB%91i-t%E1%BB%AB-c%C3%A1c-cell-l%E1%BA%A1i-kh%C3%B4ng.25905/
Thiết kế Tổng đãi ngộ (Total Rewards) theo khung SHRM
Khóa học “Thiết kế Tổng phần thưởng (Total Reward) chuẩn khung SHRM” giúp bạn nắm vững toàn bộ hệ thống đãi ngộ theo chuẩn...
Xem khóa học
Dự trù mất đầu, mất đuôi, mất giữa, mất 1, mất 2, mất n:
Câu hỏi này đã từng có trên diển đàn rồi
Cách làm như sau:
– Nối các chuổi với nhau bằng khoảng trắng
– Dùng TRIM loại các khoảng trắng thừa
– Đổi khoảng trắng thành PC
Vì phòng trường hợp chuổi trong 1 cell cũng có khoảng trắng nên thêm công đoạn này:
– Nối các chuổi với nhau bằng CHAR(13)
– Thay khoảng trắng bằng CHAR(10)
– Thay CHAR(13) bằng khoảng trắng
– Dùng TRIM cắt bỏ các khoảng trắng thừa
– Thay khoảng trắng thành PC
– Thay CHAR(10) thành khoảng trắng
Function JoinText(Vung As Range, Optional PC As String = ", ") As String
On Error GoTo Tiep1
With Application.WorksheetFunction
JoinText = Join(.Transpose(Vung), Chr(13))
GoTo Tiep2
Tiep1:
JoinText = Join(.Transpose(.Transpose(Vung)), Chr(13))
End With
Tiep2:
JoinText = Replace(JoinText, " ", Chr(10))
JoinText = Replace(JoinText, Chr(13), " ")
JoinText = WorksheetFunction.Trim(JoinText)
JoinText = Replace(JoinText, " ", PC)
JoinText = Replace(JoinText, Chr(10), " ")
End Function
Cuối cùng vẫn không xài For đâu!
Nhược điểm của cách làm này là: Trong chuổi của ta không chứa các ký tự đặc biệt (char(10) và char(13)…)… Điều này ta cũng có thể yên tâm vì việc xài các ký tự đặc biệt này là rất hiếm
Vầy thì viết như vầy không phải sẽ ngăn hơn nhiều sau! hihhi
Lâu lắm rùi mới thấy mọi người sôi nổi như vầy đó.
Thế có thể mở rộng ra nhiều vùng không liên tục bằng [ParamArray rng() As Variant] được không? Và nói trước là em không hiểu tại sao thằng ParamArray này chỉ thích đứng một mình trong code nhỉ?
https://www.giaiphapexcel.com/forum/showthread.php?t=16499
Code này không được rồi đồng chí ơi —> thử gõ vào cell A1 chữ N D U (có khoảng trắng) xem thế nào nhé!
Hình như sư phụ chưa thử code tại bài #5 của em thì phải —> Tất cả đều giải quyết được tuốt
Em vẫn quyết không dùng For —> Vấn đề là nghiên cứu thuật toán để biến cái không thể thành có thể
——————–
Đã thử code của sư phụ —> Thành công rồi!
Lâu lắm mới được "tranh" và "luận" với sư phụ trong cùng 1 topic
Sảng khoái ghê!
Quan trọng là học thêm được 1 mớ "mánh" của sư phụ (lâu lâu tung ra 1 lần)
Ẹc… Ẹc… Đầu năm đầu tháng, em xì pam chút nha!
Po xem lại nha:
– Nếu trong chuỗi có dấu phẩy, thì PC nên chọn ký tự khác, thí dụ "; " hoặc "/ "
– Code JoinTextNDU là của Ptm (lộn tiệm)
– Nếu bỏ trống ô đầu hoặc ô cuối thì code của Po vẫn còn PC đầu hoặc cuối
– Nếu trống trên 6 ô liên tiếp (7 PC liên tiếp trở lên) thì xóa không hết
Code của anh (ptm) cũng chỉ đúng với 4 PC liên tiếp trở xuống.
Nếu chạy câu JoinTextp = Replace(JoinTextp, .Rept(PC, 2), PC) 3 lần, đúng với 8 PC
Chạy 4 lần, đúng với 16 PC liên tiếp, (theo cấp số nhân, công bội là 2).
Cái tưởng là suy luận logic thì lại sai. Sai ở chỗ này:
Đúng ra là: Những sự lập lại chẵn PC (ký hiệu là 2n PC), bị thay thế bởi n PC
Đúng ra là: Những sự lập lại lẻ PC (ký hiệu là 2n + 1 PC), phần chẵn bị thay thế bởi n PC, cộng với 1 PC lẻ thành n + 1 PC
Đau quá! Chả lẽ chạy 4 lần, rồi 5 lần, 6 lần? Dù rằng 5 lần thì được 32 PC, 6 lần thì được 64 PC, nhưng không gọi là tổng quát.
Túm lại là xài mánh như Ndu hiệu quả hơn, nếu không dùng for.
Chưa được đâu!
Giả sử tại cell A1 có chuổi n,,,d,,,u thì công thức của bạn nó xóa mấy dấu phẩy "gốc" của người ta à?
Lưu ý: Cái nào là của người dùng nhập phải giữ nguyên nhé!
———————-
Bài toán thay thế này đã từng được bạn rollover79 đăng tại đây:
https://www.giaiphapexcel.com/forum/showthread.php?t=20552
Tham khảo nhé!
Đó là chuyện của người dùng, còn nhiệm vụ chúng ta sau khi nối chuổi là phải "bảo toàn lực lượng", giữ lại tất cả những gì mà người dùng đã gõ và không được chỉnh sửa gì cả
Cách làm của tôi là dùng ký tự đặc biêt để nối chuổi, nó có 1 nhược điểm khá nguy hiểm là lở như trong chuổi người ta cũng dùng ký tự đặc biệt trùng với ký tự mà mình đã dùng trong code thì coi như… tèo
Để cải tiến, ta tìm 1 ký tự đặc biệt nào đó sao cho nó cực kỳ đặc biệt, đến nổi người dùng không thể nhập từ bàn phím vào cell những ký tự kiểu như vậy!
Tôi chọn 2 ký tự này đây: vbNullChar và vbBack
Có vẽ an toàn đây!
Code cuối cùng sẽ là:
Function JoinText(Range As Range, Optional Sep As String = ", ") As String
On Error GoTo Cont1
With Application.WorksheetFunction
JoinText = Join(.Transpose(Range), vbNullChar)
GoTo Cont2
Cont1:
JoinText = Join(.Transpose(.Transpose(Range)), vbNullChar)
Cont2:
JoinText = Replace(Replace(JoinText, " ", vbBack), vbNullChar, " ")
JoinText = .Trim(JoinText)
JoinText = Replace(Replace(JoinText, " ", Sep), vbBack, " ")
End With
End Function
Mời các bạn test thử
Biết rằng thuật toán đi qua trung gian của ndu là đã quá tuyệt, nhưng với cái đầu cố chấp của lão chết tiệt, thử cải tiến giới hạn số vòng lặp bằng vòng lặp Do Loop thay vì For Next.
Nếu 1 ô trống, sẽ chạy 1 vòng lặp
Nếu dưới 4 ô trống liên tiếp, sẽ chạy 2 vòng lặp
Nếu dưới 8 ô trống liên tiếp, sẽ chạy 3 vòng lặp
Nếu dưới 16 ô trống liên tiếp, (hơi hiếm), sẽ chạy 4 vòng lặp
Nếu dưới 32 ô trống liên tiếp, (khá hiếm), sẽ chạy 5 vòng lặp
Nếu dưới 63 ô tức là 64 PC (rất hiếm), sẽ chạy 6 vòng lặp.
Nếu rời rạc nhiều vùng trống thì chỉ tính cho vùng trống lớn nhất.
Nếu không có ô trống nào, thì không chạy.
So với code của ndu (replace 4 lần) thì sẽ có lúc chạy ít lần hơn và có lúc chạy nhiều lần hơn.
Khuyến cáo duy nhất cho người dùng là nếu tồn tại các ký tự dấu phẩy, dấu gạch ngang, … thì nên dùng dấu phân cách khác.
Function JoinText(Vung As Range, Optional PC As String = ", ") As String
On Error GoTo Tiep
With Application.WorksheetFunction
JoinText = Join(.Transpose(Vung), PC)
GoTo EndF
Tiep:
JoinText = Join(.Transpose(.Transpose(Vung)), PC)
EndF:
Do While InStr(1, JoinText, .Rept(PC, 2)) > 0
JoinText = Replace(JoinText, .Rept(PC, 2), PC)
Loop
End With
If Left(JoinText, Len(PC)) = PC Then JoinText = Right(JoinText, Len(JoinText) – Len(PC))
If Right(JoinText, Len(PC)) = PC Then JoinText = Left(JoinText, Len(JoinText) – Len(PC))
End Function
Hàm JoinText đã được sửa lại như sau:
Function JoinText(ByVal Sep As String, ByVal IgnoreBlanks As Boolean, ParamArray sArray()) As String
Dim tmpArr, SubArr, Arr(), Item, n As Long
On Error Resume Next
For Each SubArr In sArray
tmpArr = SubArr
If TypeName(tmpArr) <> "Variant()" Then
If IgnoreBlanks = False Or Len(Trim(CStr(tmpArr))) > 0 Then
n = n + 1
ReDim Preserve Arr(1 To n)
Arr(n) = CStr(tmpArr)
End If
Else
For Each Item In tmpArr
If IgnoreBlanks = False Or Len(Trim(CStr(Item))) > 0 Then
n = n + 1
ReDim Preserve Arr(1 To n)
Arr(n) = CStr(Item)
End If
Next
End If
Next
If n Then JoinText = Join(Arr, Sep)
End Function
Áp dụng vào cell D19:
Gõ xong công thức, bấm tổ hợp phím Ctrl + Shift + Enter
Yêu cầu của bạn chỉ cần kết hợp với hàm OFFSET hoặc INDIRECT là được
Dùng cái này:
Hoặc cái này:
Công thức cho U5:
Copy U5, paste cho U11, U13 và U16