Addins: Nối các ô với nhau thành chuỗi, trong chuỗi các ô được cách nhau = dấu phẩy (2 người xem)

LienDong · 10/1/13

Chào cả nhà!
Do tính chất công việc thường xuyên nối chuỗi, mình nhờ các bạn viết giúp AddIns nối chuỗi như sau:

1/ Giả sử tại cột A mình có các số liệu như sau:
Cell A1: 123
Cell A2: abc
Cell A3: 456
Cell A4: LÀ CELL TRỐNG
Cell A5: 1aa
Cell A6: 789
Cell A7: def

2/ Giả sử tên Addin là Noi, mình muốn kết qủa như sau:
a/ Trường hợp 1: =Noi(A1:A3) cho kq : 123,abc,456

b/ Trường hợp 2: =Noi(A1:A5) cho kq : 123,abc,456,1aa (Lưu ý ở đây đã không tính cell trống)

c/ Trường hợp 3: =Noi(A1:A5,A7) cho kq : 123,abc,456,1aa,def

Cảm ơn các bạn đã xem & giúp đỡ.
---------------
P/s: Nếu trường hợp 2 hay 3 khó kg làm được thì có thể bỏ qua

ndu96081631 · 10/1/13

LienDong đã viết:
Chào cả nhà!
Do tính chất công việc thường xuyên nối chuỗi, mình nhờ các bạn viết giúp AddIns nối chuỗi như sau:

1/ Giả sử tại cột A mình có các số liệu như sau:
Cell A1: 123
Cell A2: abc
Cell A3: 456
Cell A4: LÀ CELL TRỐNG
Cell A5: 1aa
Cell A6: 789
Cell A7: def

2/ Giả sử tên Addin là Noi, mình muốn kết qủa như sau:
a/ Trường hợp 1: =Noi(A1:A3) cho kq : 123,abc,456

b/ Trường hợp 2: =Noi(A1:A5) cho kq : 123,abc,456,1aa (Lưu ý ở đây đã không tính cell trống)

c/ Trường hợp 3: =Noi(A1:A5,A7) cho kq : 123,abc,456,1aa,def

Cảm ơn các bạn đã xem & giúp đỡ.
---------------
P/s: Nếu trường hợp 2 hay 3 khó kg làm được thì có thể bỏ qua

Nó đây:

Mã:

Function JoinText(ByVal Sep As String, ByVal IgnoreBlanks As Boolean, ParamArray sArray()) As String
  Dim tmpArr, SubArr, Arr(), Item, n As Long, tmp As String
  'On Error Resume Next
  For Each SubArr In sArray
    tmpArr = IIf(IsArray(SubArr), SubArr, Array(SubArr))
    For Each Item In tmpArr
      tmp = IIf(TypeName(Item) = "Error", "", Trim(CStr(Item)))
      If IgnoreBlanks = False Or Len(tmp) Then
        n = n + 1
        ReDim Preserve Arr(1 To n)
        Arr(n) = tmp
      End If
    Next
  Next
  If n Then JoinText = Join(Arr, Sep)
End Function

Cú pháp
=JoinText(Dấu phân cách, bỏ qua giá trị rổng hay không?, Dữ liệu)
Ví dụ:
=JoinText(", ", TRUE, A1:A3) sẽ nối các giá trị khác rổng của vùng A1:A3 thành 1 chuổi với dấu phẩy là dấu phân cách
Hàm này cho phép nối chuổi với những điều kiện phức tạp.... Ví dụ:
=JoinText(" - ",TRUE,IF(FIND("b",$G$1:$G$4),$G$1:$G$4,""))
Nghĩa là trong vùng G1:G4, cell nào có ký tự "b" thì lấy
Hàm cũng cho phép nối các vùng không liên tục... Ví dụ:
=JoinText(", ", TRUE, A1:A5, A7)
vân vân... bạn tự khám phá nhé

nguoidienbietyeu · 17/1/13

Mình cũng có thắc mắc tương tự nhưng của mình là nối giữa các sheet với nhau, có cách nào làm nhanh hơn ko? vì mình có khá nhiều sheet. khoảng trên 50 sheet.

ndu96081631 · 17/1/13

nguoidienbietyeu đã viết:
Mình cũng có thắc mắc tương tự nhưng của mình là nối giữa các sheet với nhau, có cách nào làm nhanh hơn ko? vì mình có khá nhiều sheet. khoảng trên 50 sheet.

Má ơi! Nối chuổi ở 50 sheet, vậy kết quả nó thành cái gì nhỉ? Dài lê thê à?

AnhThu-1976 · 24/4/18

ndu96081631 đã viết:
Nó đây:

Mã:

Function JoinText(ByVal Sep As String, ByVal IgnoreBlanks As Boolean, ParamArray sArray()) As String Dim tmpArr, SubArr, Arr(), Item, n As Long, tmp As String 'On Error Resume Next For Each SubArr In sArray tmpArr = IIf(IsArray(SubArr), SubArr, Array(SubArr)) For Each Item In tmpArr tmp = IIf(TypeName(Item) = "Error", "", Trim(CStr(Item))) If IgnoreBlanks = False Or Len(tmp) Then n = n + 1 ReDim Preserve Arr(1 To n) Arr(n) = tmp End If Next Next If n Then JoinText = Join(Arr, Sep) End Function

Cú pháp
=JoinText(Dấu phân cách, bỏ qua giá trị rổng hay không?, Dữ liệu)
Ví dụ:
=JoinText(", ", TRUE, A1:A3) sẽ nối các giá trị khác rổng của vùng A1:A3 thành 1 chuổi với dấu phẩy là dấu phân cách
Hàm này cho phép nối chuổi với những điều kiện phức tạp.... Ví dụ:
=JoinText(" - ",TRUE,IF(FIND("b",$G$1:$G$4),$G$1:$G$4,""))
Nghĩa là trong vùng G1:G4, cell nào có ký tự "b" thì lấy
Hàm cũng cho phép nối các vùng không liên tục... Ví dụ:
=JoinText(", ", TRUE, A1:A5, A7)
vân vân... bạn tự khám phá nhé

Cho em hỏi, sau khi filter thì hàm nối chuỗi ở trên có thể lấy những giá trị sau khi Filter không?
Câu hỏi của em trong file đính kèm. Em cảm ơn
Chỉnh sửa: đính kèm lại file ở bài #9

Phuocam · 24/4/18

=JoinText("; ",TRUE,IF(SUBTOTAL(3,OFFSET($B$1,ROW(B2:B13)-1,)), B2:B13,""))

ndu96081631 · 24/4/18

AnhThu-1976 đã viết:
Cho em hỏi, sau khi filter thì hàm nối chuỗi ở trên có thể lấy những giá trị sau khi Filter không?
Câu hỏi của em trong file đính kèm. Em cảm ơn

Xin lưu ý rằng hàm JOINTEXT đã được cải tiến khác cái bạn đang dùng nha
Code như sau:

Mã:

Function JoinText(ByVal Delimiter As String, ParamArray Arrays()) As String
  Dim aTmp, arrDes(), Item, tmp As String
  Dim idx As Long, n As Long
  'On Error Resume Next
  For idx = LBound(Arrays) To UBound(Arrays)
    aTmp = Arrays(idx)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      If TypeName(Item) <> "Error" Then
        tmp = CStr(Item)
        n = n + 1
        ReDim Preserve arrDes(1 To n)
        arrDes(n) = tmp
      End If
    Next
  Next
  If n Then JoinText = Join(arrDes, Delimiter)
End Function

Do đó công thức bài #6 cũng phải sửa lại:

Mã:

=JoinText("; ",IF(SUBTOTAL(3,OFFSET($B$1,ROW(B2:B13)-1,)), B2:B13,1/0))

Không có TRUE, FALSE gì ráo

Phuocam · 25/4/18

ndu96081631 đã viết:
Xin lưu ý rằng hàm JOINTEXT đã được cải tiến khác cái bạn đang dùng nha

Anh cải tiến thêm tham số tùy chọn nối Không trùng cho tổng quát luôn, như

Optional ByVal isUnique As Boolean = False

Thân!

AnhThu-1976 · 25/4/18

phuocam đã viết:
=JoinText("; ",TRUE,IF(SUBTOTAL(3,OFFSET($B$1,ROW(B2:B13)-1,)), B2:B13,""))

ndu96081631 đã viết:
=JoinText("; ",IF(SUBTOTAL(3,OFFSET($B$1,ROW(B2:B13)-1,)), B2:B13,1/0))

Kết quả trên chưa đạt theo ý muốn của em (do em diễn giải chưa đúng)
Em xin nói lại ý muốn của em như sau
Sau khi chọn vùng B2:B13, thì hàm nối chuỗi của thầy Ndu sẽ ra kết quả là
=JoinText("; "; B2:B13)=1;2;3;4;5;6;7;8;9;10;11;12
Sau khi filter "chọn ngày 01/02/18" em muốn hàm nối chuỗi chỉ ra kết quả là 1;4;7;9;12
Nhờ Thầy cô & anh chị hướng dẫn thêm, em cảm ơn

♫ђöล♥ßล†♥†µ♫ · 25/4/18

AnhThu-1976 đã viết:
Kết quả trên chưa đạt theo ý muốn của em (do em diễn giải chưa đúng)
Em xin nói lại ý muốn của em như sau
Sau khi chọn vùng B2:B13, thì hàm nối chuỗi của thầy Ndu sẽ ra kết quả là
=JoinText("; "; B2:B13)=1;2;3;4;5;6;7;8;9;10;11;12
Sau khi filter "chọn ngày 01/02/18" em muốn hàm nối chuỗi chỉ ra kết quả là 1;4;7;9;12
Nhờ Thầy cô & anh chị hướng dẫn thêm, em cảm ơn

Sau khi gõ công thức xong Bạn kết thúc bằng Ctrl+Shift+Enter là được

ndu96081631 · 25/4/18

phuocam đã viết:
Anh cải tiến thêm tham số tùy chọn nối Không trùng cho tổng quát luôn, như

Optional ByVal isUnique As Boolean = False

Thân!

Mỗi hàm có tác dụng riêng mà bạn. Nếu muốn unique, bạn có thể dùng JOINIF

AnhThu-1976 · 25/4/18

phuocam đã viết:
Anh cải tiến thêm tham số tùy chọn nối Không trùng cho tổng quát luôn, như

ndu96081631 đã viết:
Mỗi hàm có tác dụng riêng mà bạn. Nếu muốn unique, bạn có thể dùng JOINIF

Em cũng đang cần cái này, Thầy có thể hướng dẫn luôn cho em, em cảm ơn!

♫ђöล♥ßล†♥†µ♫ · 25/4/18

AnhThu-1976 đã viết:
Em cũng đang cần cái này, Thầy có thể hướng dẫn luôn cho em, em cảm ơn!

Thầy đi nhậu mất rùi
Đây là hàm JOINIF của Thầy ndu96081631

HTML:

Function JoinIf(ByVal Delimiter As String, ByVal CriteriaArray, ByVal Criteria, Optional ByVal TargetArray) As String
  Dim aTmpCrit, aTmpDes, tmp1, tmp2, arr(), dic As Object
  Dim bComp As Boolean, Chk As Boolean
  Dim i As Long, j As Long, k As Long, dTmpVal As Double
  Set dic = CreateObject("Scripting.Dictionary")
  If IsMissing(TargetArray) Then TargetArray = CriteriaArray
  aTmpCrit = ConvertTo1DArray(CriteriaArray)
  aTmpDes = ConvertTo1DArray(TargetArray)
  If (Not IsArray(aTmpCrit)) Or (Not IsArray(aTmpDes)) Then Exit Function
  On Error Resume Next
  bComp = (InStr("<>=", Left(Criteria, 1)) > 0)
  For i = LBound(aTmpDes) To UBound(aTmpDes)
    tmp1 = aTmpCrit(i): tmp2 = aTmpDes(i)
    If bComp And Len(Criteria) Then
      dTmpVal = CDbl(aTmpCrit(i))
      If Evaluate(dTmpVal & Criteria) Then dic.Add tmp2, ""
    Else
      If (Left(Criteria, 1) = "!") Then
        If Not (UCase(tmp1) Like UCase(Mid(Criteria, 2, Len(Criteria)))) Then dic.Add tmp2, ""
      Else
        If (UCase(tmp1) Like UCase(Criteria)) Then dic.Add tmp2, ""
      End If
    End If
  Next
  If dic.Count Then
    arr = dic.Keys
    JoinIf = Join(arr, Delimiter)
  End If
End Function
Private Function ConvertTo1DArray(ByVal SourceArray)
  Dim aTmp, Item, arr()
  Dim n As Long
  On Error Resume Next
  aTmp = SourceArray
  If Not IsArray(aTmp) Then aTmp = Array(aTmp)
  For Each Item In aTmp
    n = n + 1
    ReDim Preserve arr(1 To n)
    arr(n) = Item
  Next
  ConvertTo1DArray = arr
End Function

AnhThu-1976 · 25/4/18

Tôi đã áp dụng hàm JoinIf, tôi muốn sau khi Filer thì chỉ lấy những giá trị không trùng
Tôi đã áp dụng công thức ở bài trên nhưng nó ra #Value! ( ở ô F1)
=JoinIf("; ";IF(SUBTOTAL(3;OFFSET($B$5;ROW(B6:B19)-5

); B6:B19;1/0))
KHông biếp áp dụng có đúng không, nhờ bạn chỉnh giúp công thức
Xin xem file đính kèm

♫ђöล♥ßล†♥†µ♫ · 25/4/18

AnhThu-1976 đã viết:
Tôi đã áp dụng hàm JoinIf, tôi muốn sau khi Filer thì chỉ lấy những giá trị không trùng
Tôi đã áp dụng công thức ở bài trên nhưng nó ra #Value! ( ở ô F1)
=JoinIf("; ";IF(SUBTOTAL(3;OFFSET($B$5;ROW(B6:B19)-5); B6:B19;1/0))
KHông biếp áp dụng có đúng không, nhờ bạn chỉnh giúp công thức
Xin xem file đính kèm

Cái công thức này: IF(SUBTOTAL(3,OFFSET($B$1,ROW(B2:B13)-1,)), B2:B13,1/0) Thầy ndu96081631 đang để nếu không thỏa mãn điều kiện sẽ bằng 1/0(#Value!)
Chi sửa lại thành: Nếu không thỏa mãn thì bằng 0. Trong hàm JoinIf Chị cho cái CriteriaArray =">0" là được
Công thức F1=JoinIf("; ";IF(SUBTOTAL(3;OFFSET($B$5;ROW(B6:B19)-5

); B6:B19;0);">0")
Em có làm trong file bài trên tại ô G1 rùi mà

ndu96081631 · 25/4/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Cái công thức này: IF(SUBTOTAL(3,OFFSET($B$1,ROW(B2:B13)-1,)), B2:B13,1/0) Thầy ndu96081631 đang để nếu không thỏa mãn điều kiện sẽ bằng 1/0(#Value!)
Chi sửa lại thành: Nếu không thỏa mãn thì bằng 0. Trong hàm JoinIf Chị cho cái CriteriaArray =">0" là được
Công thức F1=JoinIf("; ";IF(SUBTOTAL(3;OFFSET($B$5;ROW(B6:B19)-5); B6:B19;0);">0")
Em có làm trong file bài trên tại ô G1 rùi mà

Hay quá! Mình viết hàm này mà ít khi xài đến, giờ có người tùy biến đến mức thần sầu rồi hen. Cảm ơn bạn!
Ẹc.... Ẹc....
Ah! Nhân tiện nếu cột B là số thì có thể rút gọn chút:

Mã:

=JoinIf("; ",SUBTOTAL(9,OFFSET($B$5,ROW(B6:B20)-5,)),">0")

(Cặp hàm JoinText và JoinIf có thể so sánh như cặp SUMPRODUCT và SUMIF vậy đấy)

AnhThu-1976 · 26/4/18

ndu96081631 đã viết:
Ah! Nhân tiện nếu cột B là số thì có thể rút gọn chút:

Mã:

=JoinIf("; ",SUBTOTAL(9,OFFSET($B$5,ROW(B6:B20)-5,)),">0")

Cho em hỏi nếu cột B không phải là số mà là nó hỗn hợp vừa số vừa text thì công thức hay code phải sửa làm sao? em cảm ơn!

ndu96081631 · 26/4/18

AnhThu-1976 đã viết:
Cho em hỏi nếu cột B không phải là số mà là nó hỗn hợp vừa số vừa text thì công thức hay code phải sửa làm sao? em cảm ơn!

Trường hợp dữ liệu đặc biệt thì mình mới nghĩ ra cách đặc biệt, còn không thì cứ theo cách tổng quát mà làm, như bài 15 chẳng hạn

AnhThu-1976 · 26/4/18

ndu96081631 đã viết:
Trường hợp dữ liệu đặc biệt thì mình mới nghĩ ra cách đặc biệt, còn không thì cứ theo cách tổng quát mà làm, như bài 15 chẳng hạn

Đây là trường hợp của em, nhờ Thầy xem ở cột Q
Em cảm ơn!

ndu96081631 · 26/4/18

AnhThu-1976 đã viết:
Đây là trường hợp của em, nhờ Thầy xem ở cột Q
Em cảm ơn!

Thử công thức này xem sao:

Mã:

=JoinIf("; ",SUBTOTAL(3,OFFSET($Q$17,ROW(Q18:Q500)-17,)),">0",Q18:Q500)

Đừng quên Ctrl + Shift + Enter nhé

Addins: Nối các ô với nhau thành chuỗi, trong chuỗi các ô được cách nhau = dấu phẩy (2 người xem)

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

Thành viên thường trực

Huyền thoại GPE

Unsurpassed Сasual Dating Genuine Females

Huyền thoại GPE

Thành viên tích cực

Thành viên mới

Huyền thoại GPE

Thành viên mới

Thành viên tích cực

File đính kèm

Thành viên tiêu biểu

Huyền thoại GPE

Thành viên tích cực

Thành viên tiêu biểu

File đính kèm

Thành viên tích cực

File đính kèm

Thành viên tiêu biểu

Huyền thoại GPE

Thành viên tích cực

Huyền thoại GPE

Thành viên tích cực

File đính kèm

Huyền thoại GPE

Đếm ngược thời gian