Hàm lấy ký tự đầu của 5 từ đầu tiên (1 người xem)

[balano]

Hiện mình cần trợ giúp một hàm để lấy 5 ký tự đầu của 5 từ đầu tiên trong một câu.
(VD: "Giấy dán tường không tróc vôi" thì sẽ lấy ra "Gdtkt")
Rất mong được sự trợ giúp của các anh chị trên diễn đàn.

 

[Quang_Hải]

Hiện mình cần trợ giúp một hàm để lấy 5 ký tự đầu của 5 từ đầu tiên trong một câu.
(VD: "Giấy dán tường không tróc vôi" thì sẽ lấy ra "Gdtkt")
Rất mong được sự trợ giúp của các anh chị trên diễn đàn.

Bài này nếu dùng VBA thì đơn giản nhưng nếu dùng hàm có sẵn thì e rằng khó nhai

 

[balano]

Rất mong quanghai1969 hướng dẫn dùng VBA

 

[Quang_Hải]

Rất mong quanghai1969 hướng dẫn dùng VBA

Code tạm thế này

Sub tach_ky_tu()
Dim data(), i, k, kytu, tam, kq()
data = Range([A1], [A65536].End(3)).Value
ReDim kq(1 To UBound(data), 1 To 1)
For i = 1 To UBound(data)
   k = 0
   tam = Split(data(i, 1), Space(1))
   For Each kytu In tam
       k = k + 1
      kq(i, 1) = kq(i, 1) & Left(kytu, 1)
      If k = 5 Then Exit For
   Next
Next
[b1].Resize(i - 1) = kq
End Sub

 

[dhn46]

Nếu dùng công thức thì bạn thử dùn cái này xem

=LEFT(A1,1)&LEFT(TRIM(MID(SUBSTITUTE(A1," ",REPT(" ",250)),250,250)),1)&LEFT(TRIM(MID(SUBSTITUTE(A1," ",REPT(" ",250)),500,255)),1)&LEFT(TRIM(MID(SUBSTITUTE(A1," ",REPT(" ",255)),750,255)),1)&LEFT(TRIM(MID(SUBSTITUTE(A1," ",REPT(" ",255)),900,255)),1)

 

[ndu96081631]

Nếu dùng công thức thì bạn thử dùn cái này xem

=LEFT(A1,1)&LEFT(TRIM(MID(SUBSTITUTE(A1," ",REPT(" ",250)),250,250)),1)&LEFT(TRIM(MID(SUBSTITUTE(A1," ",REPT(" ",250)),500,255)),1)&LEFT(TRIM(MID(SUBSTITUTE(A1," ",REPT(" ",255)),750,255)),1)&LEFT(TRIM(MID(SUBSTITUTE(A1," ",REPT(" ",255)),900,255)),1)

Công thức này mệt chết đi được
Sao không làm nó bằng VBScript.RegExp nhỉ?
Ẹc... Ẹc...

 

[Quang_Hải]

Công thức này mệt chết đi được
Sao không làm nó bằng VBScript.RegExp nhỉ?
Ẹc... Ẹc...

Em nghĩ nếu xài VBScript thì code hơi dài

Public Function tach(cell As Range)
Dim i, tam, kq
   tam = Split(cell, Space(1))
   For i = LBound(tam) To UBound(tam)
      kq = kq & Left(tam(i), 1)
      If i = 4 Then Exit For
   Next
tach = kq
End Function

Public Function tach2(cell As Range)
Dim found, i, kq
With CreateObject("vbscript.regexp")
     .Global = True
    .Pattern = "\S+"
    Set found = .Execute(cell)
    For i = 0 To found.Count - 1
      kq = kq & Left(Trim(found.Item(i)), 1)
      If i = 4 Then Exit For
    Next
End With
tach2 = kq
End Function

 

[ndu96081631]

Em nghĩ nếu xài VBScript thì code hơi dài

Public Function tach(cell As Range)
Dim i, tam, kq
   tam = Split(cell, Space(1))
   For i = LBound(tam) To UBound(tam)
      kq = kq & Left(tam(i), 1)
      If i = 4 Then Exit For
   Next
tach = kq
End Function

Code này còn phải sửa lại rất nhiều! Bộ Hải không nghĩ sẽ có trường hợp KHOẢNG TRẮNG THỪA sao?

 

[dhn46]

Với Reg em nghĩ thế này (2 hàm cho 2 sự lựa chọn 5 ký tự và tùy ý ký tự)

Function CharSplit(ByVal Str As String)
    With CreateObject("Vbscript.regexp")
        .Global = True
        .Pattern = " \w"
        With .Execute(" " & Str)
            CharSplit = Trim(.Item(0)) & Trim(.Item(1)) & Trim(.Item(2)) & Trim(.Item(3)) & Trim(.Item(4))
        End With
    End With
End Function
'---------------------------------------------------------------------------------------------------
Function CharSplit1(ByVal Str As String, ByVal Num As Long)
    With CreateObject("Vbscript.regexp")
        .Global = True
        .Pattern = " \w"
        For i = 0 To Num - 1
            CharSplit1 = CharSplit1 & Trim(.Execute(" " & Str).Item(i))
        Next
    End With
End Function

 

[ndu96081631]

Chơi chiêu tà đạo xem nào:

Function TenTat(ByVal Text As String) As String
  Dim strTmp As String
  strTmp = WorksheetFunction.Trim(Text)
  strTmp = "{""" & Replace(strTmp, " ", """;""") & """}"
  TenTat = Left(Join(Evaluate("Transpose(LEFT(" & strTmp & ",1))"), ""), 5)
End Function

Không biết có lỗi nào phát sinh không?
Ẹc... Ẹc...