Lấy các từ trong chuỗi theo điều kiện

[hongphuong1997]

Nhờ các bác và anh chị giúp cháu viết hàm như file đính kèm.
Cháu xin cảm ơn ạ

 

[htin1997]

Nhờ các bác và anh chị giúp cháu viết hàm như file đính kèm.
Cháu xin cảm ơn ạ

=TEXTJOIN("_",,IFERROR(INDEX(TEXTSPLIT(TEXTJOIN("_",,C4:E7),"_"),SEQUENCE(1000,,2,2)),""))

Hình như kết quả mong muốn đang sai bạn ơi."hoi" rồi tới "Ky" chứ?

 

[hongphuong1997]

=TEXTJOIN("_",,IFERROR(INDEX(TEXTSPLIT(TEXTJOIN("_",,C4:E7),"_"),SEQUENCE(1000,,2,2)),""))

Hình như kết quả mong muốn đang sai bạn ơi."hoi" rồi tới "Ky" chứ?

Em cảm ơn anh ạ.
Nhưng anh oi, Office của em chưa có hàm SEQUENCE

SEQUENCE

 

[htin1997]

chưa có hàm SEQUENCE

Thay bằng ROW(A1:A999)*2 thử xem nha.

 

[hongphuong1997]

Thay bằng ROW(A1:A999)*2 thử xem nha.

=TEXTJOIN("_";;IFERROR(INDEX(TEXTSPLIT(TEXTJOIN("_";;C4:E7);"_");ROW(A1:A999)*2);""))
Không được anh oi

 

[htin1997]

=TEXTJOIN("_";;IFERROR(INDEX(TEXTSPLIT(TEXTJOIN("_";;C4:E7);"_");ROW(A1:A999)*2);""))
Không được anh oi

Chắc là TEXRSPLIT cũng không có, hình như TEXTSPLIT còn ra sau cả SEQUENCE.
Thay TEXTSPLIT bằng UDF này nha, cú pháp: T_Tachchuoi([chuỗi cần tách],[ phân cách bởi])

Function T_Tachchuoi(str As String, Optional txt As String)
Application.Volatile
Dim i As Integer, z As Integer, x As Integer, a As Integer
Name = Application.WorksheetFunction.Trim(Application.WorksheetFunction.Substitute(str, Chr(160), Chr(32)))
z = 0: a = 1: x = 1
For i = 1 To Len(Name)
     If Mid(Name, i, Len(txt)) = txt Or i = Len(Name) Then z = z + 1
Next
ReDim Arr(0, 1 To z)
For i = 2 To Len(Name) + 1
     If Mid(Name, i, Len(txt)) = txt Or i = Len(Name) Then
          Arr(0, x) = Replace(Mid(Name, a, i - a + Len(txt)), txt, "")
          a = i
          x = x + 1
     End If
Next
T_Tachchuoi = Arr
End Function

=TEXTJOIN("_";;IFERROR(INDEX(T_Tachchuoi(TEXTJOIN("_";;C4:E7);"_");ROW(A1:A999)*2);""))

 

[hongphuong1997]

Chắc là TEXRSPLIT cũng không có, hình như TEXTSPLIT còn ra sau cả SEQUENCE.
Thay TEXTSPLIT bằng UDF này nha, cú pháp: T_Tachchuoi([chuỗi cần tách],[ phân cách bởi])

Function T_Tachchuoi(str As String, Optional txt As String)
Application.Volatile
Dim i As Integer, z As Integer, x As Integer, a As Integer
Name = Application.WorksheetFunction.Trim(Application.WorksheetFunction.Substitute(str, Chr(160), Chr(32)))
z = 0: a = 1: x = 1
For i = 1 To Len(Name)
     If Mid(Name, i, Len(txt)) = txt Or i = Len(Name) Then z = z + 1
Next
ReDim Arr(0, 1 To z)
For i = 2 To Len(Name) + 1
     If Mid(Name, i, Len(txt)) = txt Or i = Len(Name) Then
          Arr(0, x) = Replace(Mid(Name, a, i - a + Len(txt)), txt, "")
          a = i
          x = x + 1
     End If
Next
T_Tachchuoi = Arr
End Function

=TEXTJOIN("_";;IFERROR(INDEX(T_Tachchuoi(TEXTJOIN("_";;C4:E7);"_");ROW(A1:A999)*2);""))

Anh oi, cú pháp của hàm viết như nào hở anh?
Em làm mãi không được: =T_Tachchuoi(C4;D6;E7;"_")

 

[htin1997]

Mình thay cho rồi mà

 

[hongphuong1997]

Em làm mãi không được anh oi
Em dùng hàm này mừ không được a

Public Function JOINTEXT(Delimiter As String, Ignore_Empty As Boolean, ParamArray Text1() As Variant) As String
  'Cách dùng thì tuong t?, v?i cú pháp: JOINTEXT(Ký t? phân cách, L?c b? tr?ng, Vùng n?i chu?i)
  'PURPOSE: Replicates The Excel 2016 Function CONCAT
  'UPGRADED by: HocExcel.Online
  'SOURCE: www.TheSpreadsheetGuru.com

  Dim Cell As Variant, RangeArea As Variant
  Dim x As Long

'Loop Through Each Cell in Given Input
  For Each RangeArea In Text1
    If TypeName(RangeArea) = "Range" Then
      For Each Cell In RangeArea
        If Len(Cell.Value) <> 0 Or Ignore_Empty = False Then
          JOINTEXT = JOINTEXT & Delimiter & Cell.Value
        End If
      Next Cell
    ElseIf TypeName(RangeArea) = "Variant()" Then
  'Update: 20181129
        For Each Cell In RangeArea
            If Len(Cell) <> 0 Or Ignore_Empty = False Then
                      JOINTEXT = JOINTEXT & Delimiter & Cell
            End If
        Next
    Else
      'Text String was Entered
        If Len(RangeArea) <> 0 Or Ignore_Empty = False Then
          JOINTEXT = JOINTEXT & Delimiter & RangeArea
        End If
    End If
  Next RangeArea

JOINTEXT = Mid(JOINTEXT, Len(Delimiter) + 1)

End Function

 

[htin1997]

À TEXTJOIN cũng không có à. Thế chờ người giác giúp nhé, mình tới đây thôi

 

[hongphuong1997]

À TEXTJOIN cũng không có à. Thế chờ người giác giúp nhé, mình tới đây thôi

Hàm tự tạo mừ anh

 

[Thóc Sama]

Hàm tự tạo mừ anh

Cô mình thử hàm sau xem được không?
Cú pháp: =Sj(chọn vùng)

Function Sj(ByVal vung As Range) As String
    Dim Res$, i&, j&, Txt$, tmp
    For i = 1 To vung.Cells.Count
        Txt = vung.Cells(i).Value
        tmp = Split(Txt, "_")
        For j = 1 To UBound(tmp) Step 2
            Res = Res & tmp(j) & "_"
        Next j
    Next i
    If Right(Res, 1) = "_" Then
        Res = Left(Res, Len(Res) - 1)
    End If
    Sj = Res
End Function

 

[HieuCD]

Nhờ các bác và anh chị giúp cháu viết hàm như file đính kèm.
Cháu xin cảm ơn ạ

Kiểm tra lại . .

Function NoiTu(ByVal deli As String, ParamArray aRng() As Variant) As String
  Dim a, b, S, str$, i&
  For Each a In aRng
    If IsArray(a) Then
      For Each b In a
        If b <> Empty Then
          Call GanKQ(str, deli, S, i, b)
        End If
      Next b
    Else
      Call GanKQ(str, deli, S, i, a)
    End If
  Next a
  If str <> Empty Then NoiTu = Mid(str, 2)
End Function
Private Sub GanKQ(str, deli, S, i, ByVal b As String)
  S = Split(deli & b, deli)
  If UBound(S) > 1 Then
    For i = 2 To UBound(S) Step 2
      If S(i) <> Empty Then str = str & deli & S(i)
    Next i
  End If
End Sub

Công thức
= NoiTu("_",C4, D6:E7)

 

[bebo021999]

Làm đại cái hàm ghép chuỗi này xài đỡ nhé

Option Explicit
Function GhepChuoi(ParamArray ranges() As Variant) As String
Dim rng, cell, i&, k&, st, chuoi As String
For Each rng In ranges
    For Each cell In rng
        st = Split(cell, "_")
        For i = 1 To UBound(st) Step 2
            chuoi = chuoi & "_" & st(i)
        Next
    Next
Next
GhepChuoi = chuoi
End Function

 

[hongphuong1997]

Kiểm tra lại . .

Function NoiTu(ByVal deli As String, ParamArray aRng() As Variant) As String
  Dim a, b, S, str$, i&
  For Each a In aRng
    If IsArray(a) Then
      For Each b In a
        If b <> Empty Then
          Call GanKQ(str, deli, S, i, b)
        End If
      Next b
    Else
      Call GanKQ(str, deli, S, i, a)
    End If
  Next a
  If str <> Empty Then NoiTu = Mid(str, 2)
End Function
Private Sub GanKQ(str, deli, S, i, ByVal b As String)
  S = Split(deli & b, deli)
  If UBound(S) > 1 Then
    For i = 2 To UBound(S) Step 2
      If S(i) <> Empty Then str = str & deli & S(i)
    Next i
  End If
End Sub

Công thức
= NoiTu("_",C4, D6:E7)

Cháu cảm ơn Bác @HieuCD, @bebo021999 , anh @THÓC SAMA
Hàm rất chuẩn các bác oi, cháu rất cảm ơn ạ.
Có hàm của đại ca ca @THÓC SAMA co nhược điểm (Không chọn được riêng từng ô vùng).
Cháu chúc toàn thể các bác và anh chị cả ngày không mất điện ạ.
À giờ này bên đó Bác @HieuCD vẫn đang nửa đêm mừ Bác bị mất điện hay sao không ngủ được hở Bác?

 

[Nhattanktnn]

À giờ này bên đó Bác @HieuCD vẫn đang nửa đêm mừ Bác bị mất điện hay sao không ngủ được hở Bác?

Cúp điện nên bác ấy đang đi thuê máy phát điện hoặc mua cục phát wifi để mở máy tính lên viết code cho em chứ nào ngủ được