Lọc chuỗi có dấu và không dấu Tiếng Việt bằng Excel VBa

minahnh0011 đã viết:

Mong GPE giúp đỡ
Tôi có dữ liệu gồm các chuỗi là những tin nhắn nằm ở cột B, có tin nhắn không dấu và có dấu Tiếng Việt tôi muốn tách những tin nhắn đủ điều kiện ở cột E và chứa dấu tiếng Việt ra cột C.
Rất mong được sự giúp đỡ ạ

Nhấp chuột vào đây để mở rộng...

Public Function Tim(Cll, BangDk)
    Dim Kt, I, Str, A
    Kt = "8225 8224 7843 8227 7841 8259 7855 7857 7859 7861 7863 8226 7845 7847 7849 7851 7853 8233 8232 7867 7869 7865 8234 7871 7873 7875 7877 7879 8237 8236 7881 8297 7883 8243 8242 7887 8245 7885 8244 7889 7891 7893 7895 7897 8417 7899 7901 7903 7905 7907 8250 8249 7911 8361 7909 8432 7913 7915 7917 7919 7921 8253 7923 7927 7929 7925 8193 8192 7842 8195 7840 8258 7854 7856 7858 7860 7862 8194 7844 7846 7848 7850 7852 8201 8200 7866 7868 7864 8202 7870 7872 7874 7876 7878 8205 8204 7880 8296 7882 8211 8210 7886 8213 7884 8212 7888 7890 7892 7894 7896 8416 7898 7900 7902 7904 7906 8218 8217 7910 8360 7908 8431 7912 7914 7916 7918 7920 8221 7922 7926 7928 7924"
        If Application.WorksheetFunction.CountIf(BangDk, Cll) Then
            Tim = Cll: Exit Function
        End If
            For I = 1 To Len(Cll)
                Str = Right(88 & AscW(Mid(Cll, I, 1)), 4)
                If InStr(Kt, Str) Then
                    Tim = Cll: Exit Function
                End If
            Next I
    Tim = ""
End Function

concogia đã viết:

Ngồi buồn làm chơi chứ bài này giải quyết triệt để khó lắm, nói theo Smod Ndu : "ai biết có con sâu nào trong trái ổi" (hihi, không đúng nguyên văn thì phải. Híc)

PHP:Sao chép.

Public Function Tim(Cll, BangDk)
    Dim Kt, I, Str, A
    Kt = "8225 8224 7843 8227 7841 8259 7855 7857 7859 7861 7863 8226 7845 7847 7849 7851 7853 8233 8232 7867 7869 7865 8234 7871 7873 7875 7877 7879 8237 8236 7881 8297 7883 8243 8242 7887 8245 7885 8244 7889 7891 7893 7895 7897 8417 7899 7901 7903 7905 7907 8250 8249 7911 8361 7909 8432 7913 7915 7917 7919 7921 8253 7923 7927 7929 7925 8193 8192 7842 8195 7840 8258 7854 7856 7858 7860 7862 8194 7844 7846 7848 7850 7852 8201 8200 7866 7868 7864 8202 7870 7872 7874 7876 7878 8205 8204 7880 8296 7882 8211 8210 7886 8213 7884 8212 7888 7890 7892 7894 7896 8416 7898 7900 7902 7904 7906 8218 8217 7910 8360 7908 8431 7912 7914 7916 7918 7920 8221 7922 7926 7928 7924"
        If Application.WorksheetFunction.CountIf(BangDk, Cll) Then
            Tim = Cll: Exit Function
        End If
            For I = 1 To Len(Cll)
                Str = Right(88 & AscW(Mid(Cll, I, 1)), 4)
                If InStr(Kt, Str) Then
                    Tim = Cll: Exit Function
                End If
            Next I
    Tim = ""
End Function

Thân

Nhấp chuột vào đây để mở rộng...

minahnh0011 đã viết:

Anh concogia, Function trên của anh có thể chuyển thành Sub được không, cảm ơn anh concogia

Nhấp chuột vào đây để mở rộng...

Public Sub TinNhan()
    Dim Vung, BangDk, Dk, I, J, Kq, Str
    Vung = Range([B5], [B5000].End(xlUp))
    Set BangDk = Range([D4], [D4].End(xlDown))
    ReDim Kq(1 To UBound(Vung), 1 To 1)
    Dk = "8225 8224 7843 8227 7841 8259 7855 7857 7859 7861 7863 8226 7845 7847 7849 7851 7853 8233 8232 7867 7869 7865 8234 7871 7873 7875 7877 7879 8237 8236 7881 8297 7883 8243 8242 7887 8245 7885 8244 7889 7891 7893 7895 7897 8417 7899 7901 7903 7905 7907 8250 8249 7911 8361 7909 8432 7913 7915 7917 7919 7921 8253 7923 7927 7929 7925 8193 8192 7842 8195 7840 8258 7854 7856 7858 7860 7862 8194 7844 7846 7848 7850 7852 8201 8200 7866 7868 7864 8202 7870 7872 7874 7876 7878 8205 8204 7880 8296 7882 8211 8210 7886 8213 7884 8212 7888 7890 7892 7894 7896 8416 7898 7900 7902 7904 7906 8218 8217 7910 8360 7908 8431 7912 7914 7916 7918 7920 8221 7922 7926 7928 7924"
        For I = 1 To UBound(Vung)
            If Application.WorksheetFunction.CountIf(BangDk, Vung(I, 1)) Then Kq(I, 1) = Vung(I, 1)
            For J = 1 To Len(Vung(I, 1))
                Str = Right(88 & AscW(Mid(Vung(I, 1), J, 1)), 4)
                If InStr(Dk, Str) Then Kq(I, 1) = Vung(I, 1)
            Next J
        Next I
    [C5].Resize(I - 1) = Kq
End Sub

concogia đã viết:

Dùng Function thì nó linh động hơn, nếu chuyển thành Sub thì các vùng "Dữ liệu" & " Điều kiện thêm" phải có địa chỉ cụ thể, thêm một vòng lặp duyệt qua các cell dữ liệu thôi, đơn giản mà
Đại khái Sub sẽ như thế này với dữ liệu trong bài của bạn

PHP:Sao chép.

Public Sub TinNhan()
    Dim Vung, BangDk, Dk, I, J, Kq, Str
    Vung = Range([B5], [B5000].End(xlUp))
    Set BangDk = Range([D4], [D4].End(xlDown))
    ReDim Kq(1 To UBound(Vung), 1 To 1)
    Dk = "8225 8224 7843 8227 7841 8259 7855 7857 7859 7861 7863 8226 7845 7847 7849 7851 7853 8233 8232 7867 7869 7865 8234 7871 7873 7875 7877 7879 8237 8236 7881 8297 7883 8243 8242 7887 8245 7885 8244 7889 7891 7893 7895 7897 8417 7899 7901 7903 7905 7907 8250 8249 7911 8361 7909 8432 7913 7915 7917 7919 7921 8253 7923 7927 7929 7925 8193 8192 7842 8195 7840 8258 7854 7856 7858 7860 7862 8194 7844 7846 7848 7850 7852 8201 8200 7866 7868 7864 8202 7870 7872 7874 7876 7878 8205 8204 7880 8296 7882 8211 8210 7886 8213 7884 8212 7888 7890 7892 7894 7896 8416 7898 7900 7902 7904 7906 8218 8217 7910 8360 7908 8431 7912 7914 7916 7918 7920 8221 7922 7926 7928 7924"
        For I = 1 To UBound(Vung)
            If Application.WorksheetFunction.CountIf(BangDk, Vung(I, 1)) Then Kq(I, 1) = Vung(I, 1)
            For J = 1 To Len(Vung(I, 1))
                Str = Right(88 & AscW(Mid(Vung(I, 1), J, 1)), 4)
                If InStr(Dk, Str) Then Kq(I, 1) = Vung(I, 1)
            Next J
        Next I
    [C5].Resize(I - 1) = Kq
End Sub

Thân

Nhấp chuột vào đây để mở rộng...

minahnh0011 đã viết:

Cảm ơn anh Concogia, anh xem qua bài này giúp em
em có danh sách tên riêng của Nam ở Cột E, Nữ ở cột G, Cột B là tên đầy đủ, nếu Dữ liệu trong cột B chứa E thì để "Nam" , chứa G thì để "Nữ", nếu không thì để "Bạn", anh giúp em, code lúc trước do Anh Ba Tê giúp

Nhấp chuột vào đây để mở rộng...