Lọc tên duy nhất trong cột để gửi E-mail

[rubia]

Chào các anh chị,

Em đang chỉnh sửa lại form viết email, trong đó có phần lấy tên người trong bảng dữ liệu để đề cập trong phần Dear....
Em gặp vấn đề là không dò loại bỏ được các tên đã trùng, chi tiết em có ghi ở hình và kèm file, câu lệnh em viết ở dưới.

Câu lệnh của em như sau:

Option Explicit
Sub Dear()
    Dim sup_name, Text As String
    Dim lastRow, pos, I, J As Integer
    lastRow = ThisWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    'Dear
    sup_name = ""
    For I = 2 To lastRow
        Text = Cells(I, 1)
        pos = InStr(1, Text, "-")
        For J = pos To 1 Step -1
            If Mid(Text, J - 2, 1) = " " Then
                sup_name = sup_name & " Mr. " & Mid(Text, J - 1, pos - J) & ", "
                Exit For
            End If
        Next J
    Next I
    Cells(2, "B") = "Dear " & sup_name
End Sub

Mong các ah chị giúp đỡ em, em cảm ơn ạ.

 

[Phuocam]

Trường hợp Le hong Anh và Le Duc Anh => kết quả là Mr. Anh, Mr. Anh

Sub DearMr()
    Dim sup_name, Text As String
    Dim lastRow As Long, pos, I, J As Integer
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    lastRow = ThisWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    'Dear
    sup_name = ""
    For I = 2 To lastRow
        Text = Cells(I, 1)
        
        If dic.exists(Text) = False Then
            dic.Add Text, ""
            pos = InStr(1, Text, "-")
            For J = pos To 1 Step -1
                If Mid(Text, J - 2, 1) = " " Then
                    sup_name = sup_name & " Mr. " & Mid(Text, J - 1, pos - J) & ", "
                    Exit For
                End If
            Next J
        End If
    Next I
    Cells(2, "B") = "Dear " & sup_name
End Sub

 

[congnguyen88]

Chào các anh chị,

Em đang chỉnh sửa lại form viết email, trong đó có phần lấy tên người trong bảng dữ liệu để đề cập trong phần Dear....
Em gặp vấn đề là không dò loại bỏ được các tên đã trùng, chi tiết em có ghi ở hình và kèm file, câu lệnh em viết ở dưới.

Câu lệnh của em như sau:

Option Explicit
Sub Dear()
    Dim sup_name, Text As String
    Dim lastRow, pos, I, J As Integer
    lastRow = ThisWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    'Dear
    sup_name = ""
    For I = 2 To lastRow
        Text = Cells(I, 1)
        pos = InStr(1, Text, "-")
        For J = pos To 1 Step -1
            If Mid(Text, J - 2, 1) = " " Then
                sup_name = sup_name & " Mr. " & Mid(Text, J - 1, pos - J) & ", "
                Exit For
            End If
        Next J
    Next I
    Cells(2, "B") = "Dear " & sup_name
End Sub

Mong các ah chị giúp đỡ em, em cảm ơn ạ.
View attachment 234318

Quá đơn giản đối với anh

Sub MAzda()
    Dim sup_name, Text As String, a As Long, b As Long, c As lomg
    Dim lastRow As Long, pos, I, J As Integer
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    lastRow = ThisWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    'Dear
    sup_name = ""
    For I = 2 To lastRow
        Text = Cells(I, 1 + 5 - 5)
        
        If dic.exists(Text) = False Then
            dic.Add Text, ""
            pos = InStr(1, Text, "-")
            For J = pos To 1 Step -1
                If Mid(Text, J - 2 + 3 - 3, 1) = " " Then
                    sup_name = sup_name & " Mr. " & Mid(Text, J - 1, pos - J) & ", "
                    Exit For
                End If
            Next J
        End If
    Next I
    Cells(2 + 4 - 4, "B") = "Dear " & sup_name
End Sub

 

[rubia]

Trường hợp Le hong Anh và Le Duc Anh => kết quả là Mr. Anh, Mr. Anh

Sub DearMr()
    Dim sup_name, Text As String
    Dim lastRow As Long, pos, I, J As Integer
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
   
    lastRow = ThisWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    'Dear
    sup_name = ""
    For I = 2 To lastRow
        Text = Cells(I, 1)
       
        If dic.exists(Text) = False Then
            dic.Add Text, ""
            pos = InStr(1, Text, "-")
            For J = pos To 1 Step -1
                If Mid(Text, J - 2, 1) = " " Then
                    sup_name = sup_name & " Mr. " & Mid(Text, J - 1, pos - J) & ", "
                    Exit For
                End If
            Next J
        End If
    Next I
    Cells(2, "B") = "Dear " & sup_name
End Sub

Em cảm ơn anh/chị đã giúp ạ, chúc anh/chị một ngày vui vẻ

Bài đã được tự động gộp: 29/3/20

Quá đơn giản đối với anh

Sub MAzda()
    Dim sup_name, Text As String, a As Long, b As Long, c As lomg
    Dim lastRow As Long, pos, I, J As Integer
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
   
    lastRow = ThisWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    'Dear
    sup_name = ""
    For I = 2 To lastRow
        Text = Cells(I, 1 + 5 - 5)
       
        If dic.exists(Text) = False Then
            dic.Add Text, ""
            pos = InStr(1, Text, "-")
            For J = pos To 1 Step -1
                If Mid(Text, J - 2 + 3 - 3, 1) = " " Then
                    sup_name = sup_name & " Mr. " & Mid(Text, J - 1, pos - J) & ", "
                    Exit For
                End If
            Next J
        End If
    Next I
    Cells(2 + 4 - 4, "B") = "Dear " & sup_name
End Sub

Dạ, e cũng tìm trên mạng và nghe một số bạn kêu dùng Dictionary nhưng không ngờ nó lợi hại quá, một số vấn đề liên quan cái này e dùng for next và if then cũng ra, nhưng riêng trường hợp này e làm không ra. Cảm ơn anh/chị đã hướng dẫn nhiệt tình ạ

 

[congnguyen88]

Em cảm ơn anh/chị đã giúp ạ, chúc anh/chị một ngày vui vẻ

Bài đã được tự động gộp: 29/3/20

Dạ, e cũng tìm trên mạng và nghe một số bạn kêu dùng Dictionary nhưng không ngờ nó lợi hại quá, một số vấn đề liên quan cái này e dùng for next và if then cũng ra, nhưng riêng trường hợp này e làm không ra. Cảm ơn anh/chị đã hướng dẫn nhiệt tình ạ

Ok em có câu nào khó khó lên. Chữ dể quá chưa đủ đô với anh