Lấy chữ cái đầu trong chuỗi (2 người xem)

[timhocexcel]

Tôi là học sinh => TLHS
Quyển sách tập 1 => QST1
Hay hay=>HH
Trên con đường đến trường=> TCĐĐT
Nhờ các bạn hướng dẫn lấy một chữ cái đầu trong chuỗi và đổi các chữ cái đó thành chữ in hoa.

 

[snow25]

Tôi là học sinh => TLHS
Quyển sách tập 1 => QST1
Hay hay=>HH
Trên con đường đến trường=> TCĐĐT
Nhờ các bạn hướng dẫn lấy một chữ cái đầu trong chuỗi và đổi các chữ cái đó thành chữ in hoa.

Thử cái này.

Function laychu(ByVal dk As String) As String
       Dim T
       For Each T In Split(dk, " ")
           laychu = laychu & UCase(Left(T, 1))
       Next
End Function

=laychu(A1)

 

[timhocexcel]

Thử cái này.

Function laychu(ByVal dk As String) As String
       Dim T
       For Each T In Split(dk, " ")
           laychu = laychu & UCase(Left(T, 1))
       Next
End Function

=laychu(A1)

Bạn sửa code lại giùm, ví dụ: Ăn cơm => AC,
Ông lão=> OL
Code trên là lấy chữ cái đầu nhưng vẫn lấy dấu của chữ cái, bạn chỉnh sửa lại lấy chữ cái đầu nhưng không lấy dấu,

 

[giaiphap]

Bạn sửa code lại giùm, ví dụ: Ăn cơm => AC,
Ông lão=> OL
Code trên là lấy chữ cái đầu nhưng vẫn lấy dấu của chữ cái, bạn chỉnh sửa lại lấy chữ cái đầu nhưng không lấy dấu,

Vậy mượn code của @snow25 và thêm chút gia vị nhé, đoạn code dưới dùng cho bảng mã Unicode.

Function laychu(ByVal dk As String) As String
       Dim T
       For Each T In Split(dk, " ")
           laychu = laychu & UCase(Left(T, 1))
       Next
       laychu = LoaiDauTViet(laychu)
End Function
Public Function LoaiDauTViet(s As String) As String
Dim i As Integer, sStr As String, Dau As String, Bdau As String
            Dau = ChrW(193) & ChrW(225) & ChrW(192) & ChrW(224) & ChrW(7842) & ChrW(7843) & ChrW(195) & ChrW(227) & ChrW(7840) & ChrW(7841) & ChrW(258) & ChrW(259) & _
            ChrW(7854) & ChrW(7855) & ChrW(7856) & ChrW(7857) & ChrW(7858) & ChrW(7859) & ChrW(7860) & ChrW(7861) & ChrW(7862) & ChrW(7863) & ChrW(194) & ChrW(226) & _
            ChrW(7844) & ChrW(7845) & ChrW(7846) & ChrW(7847) & ChrW(7848) & ChrW(7849) & ChrW(7850) & ChrW(7851) & ChrW(7852) & ChrW(7853) & ChrW(272) & ChrW(273) & _
            ChrW(201) & ChrW(233) & ChrW(200) & ChrW(232) & ChrW(7866) & ChrW(7867) & ChrW(7868) & ChrW(7869) & ChrW(7864) & ChrW(7865) & ChrW(202) & ChrW(234) & ChrW(7870) & _
            ChrW(7871) & ChrW(7872) & ChrW(7873) & ChrW(7874) & ChrW(7875) & ChrW(7876) & ChrW(7877) & ChrW(7878) & ChrW(7879) & ChrW(205) & ChrW(237) & ChrW(204) & _
            ChrW(236) & ChrW(7880) & ChrW(7881) & ChrW(296) & ChrW(297) & ChrW(7882) & ChrW(7883) & ChrW(211) & ChrW(243) & ChrW(210) & ChrW(242) & ChrW(7886) & ChrW(7887) & _
            ChrW(213) & ChrW(245) & ChrW(7884) & ChrW(7885) & ChrW(212) & ChrW(244) & ChrW(7888) & ChrW(7889) & ChrW(7890) & ChrW(7891) & ChrW(7892) & ChrW(7893) & ChrW(7894) & _
            ChrW(7895) & ChrW(7896) & ChrW(7897) & ChrW(416) & ChrW(417) & ChrW(7898) & ChrW(7899) & ChrW(7900) & ChrW(7901) & ChrW(7902) & ChrW(7903) & ChrW(7904) & ChrW(7905) & _
            ChrW(7906) & ChrW(7907) & ChrW(218) & ChrW(250) & ChrW(217) & ChrW(249) & ChrW(7910) & ChrW(7911) & ChrW(360) & ChrW(361) & ChrW(7908) & ChrW(7909) & ChrW(431) & _
            ChrW(432) & ChrW(7912) & ChrW(7913) & ChrW(7914) & ChrW(7915) & ChrW(7916) & ChrW(7917) & ChrW(7918) & ChrW(7919) & ChrW(7920) & ChrW(7921) & ChrW(221) & ChrW(253) & _
            ChrW(7922) & ChrW(7923) & ChrW(7926) & ChrW(7927) & ChrW(7928) & ChrW(7929) & ChrW(7924) & ChrW(7925)
            Bdau = "AaAaAaAaAaAaAaAaAaAaAaAaAaAaAaAaAaDdEeEeEeEeEeEeEeEeEeEeEeIiIiIiIiIiOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoUuUuUuUuUuUuUuUuUuUuUuYyYyYyYyYy"
                For i = 1 To Len(s)
                    If InStr(1, Dau, Mid(s, i, 1)) > 0 Then
                        sStr = sStr & Mid(Bdau, InStr(1, Dau, Mid(s, i, 1)), 1)
                    Else
                        sStr = sStr & Mid(s, i, 1)
                    End If
                Next i
    LoaiDauTViet = sStr
End Function