Hỗ trợ hàm UDF tách chữ in nghiêng

[Tình nghĩa giang hồ]

Xin chào các anh em GPE, mình có bài tập tách chữ in nghiêng, nhờ các anh em hỗ trợ giúp.
Nội dung tập chỉ đơn giản là chỗ nào in nghiêng thì mình tách nó ra ra cột khác thôi, ngày xưa mình có thấy 1 bạn làm bạn wilcards của word cũng tách được.
Tiếc rằng lúc đó không có nhu cầu, sau này gặp trường hợp thì lại không biết làm, và sẵn nó cũng trên nền Excel nên thôi nhờ các anh em hỗ trợ giúp mình bài này với.
Đa tạ các anh em.

 

[vanaccex]

Tham khảo code này, code được tham khảo của Thành viên Giaiphapexcel.com

Function TachChuNghieng(r As Range) As String
    Dim S$, s1$, s2$, i&, j&, n&, chk As Boolean, chk2 As Boolean
    Dim rex As Object
    Set rex = CreateObject("VBScript.RegExp")
   
    S = r.Text
    With rex
        .Pattern = "\W"
        .Global = True
        s1 = .Replace(S, " ")
    End With
   
    n = Len(S)
    i = 1
    Do While i <= n
        chk2 = r.Characters(i, 1).Font.Italic
        If chk2 And (Not chk) Then s2 = s2 & "; "
        chk = chk2
       
        If Mid(s1, i, 1) = " " Then
            If chk2 Then s2 = s2 & Mid(S, i, 1)
            i = i + 1
        Else
            j = InStr(i, s1, " ")
            If j = 0 Then
                If chk2 Then s2 = s2 & Right(S, n - i + 1)
                GoTo Thoat
            End If
            If chk2 Then s2 = s2 & Mid(S, i, j - i)
            i = j
        End If
    Loop
Thoat:
    n = Len(s2)
    If n > 0 Then TachChuNghieng = Right(s2, n - 2)
End Function

 

[Tình nghĩa giang hồ]

Xin đa tạ vanaccex. Hàm UDF này xài rất ngon lành. Cảm ơn vanaccex nhiều.

 

[CHAOQUAY]

Xin chào các anh em GPE, mình có bài tập tách chữ in nghiêng, nhờ các anh em hỗ trợ giúp.
Nội dung tập chỉ đơn giản là chỗ nào in nghiêng thì mình tách nó ra ra cột khác thôi, ngày xưa mình có thấy 1 bạn làm bạn wilcards của word cũng tách được.
Tiếc rằng lúc đó không có nhu cầu, sau này gặp trường hợp thì lại không biết làm, và sẵn nó cũng trên nền Excel nên thôi nhờ các anh em hỗ trợ giúp mình bài này với.
Đa tạ các anh em.

Thử thêm 1 cách

Option Explicit

Function Tach(Chuoi As Range) As String
Dim Kq, j, k
k = 1
For Each j In Split(Chuoi)
    If Chuoi.Characters(k, 1).Font.Italic = True Then
        Kq = Kq & " " & j
    End If
    k = k + Len(j) + 1
Next j
Tach = Trim(Kq)
End Function