Viết VBA theo qui luật để tạo mail (1 người xem)

[khanhvc2003]

Chào các bạn,

Có danh sách ví dụ như dưới và yêu cầu là:

1. Nếu là người việt nam thì email phải tạo là Tên (chữ cuối cùng)+ các ký tự đầu tiên của Họ và tên lót
2. Nếu là người nước ngoài thì email phải tạo là Tên (chữ đầu tiên)+ các ký tự đầu tiên của Họ và tên lót
3. Nếu email tạo ra đã tồn tại thì phải thêm số đếm phía sau

Mình viết VBA hoặc lập hàm cho yêu cầu trên nhưng không biết làm, mong được hỗ trợ.

Xin cám ơn.


[TABLE="width: 543"]
[TR]
[TD]STT[/TD]
[TD]Ho ten[/TD]
[TD]Nguoi Viet Nam[/TD]
[TD]email[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD]TRAN THI DIEP[/TD]
[TD]Y[/TD]
[TD]DiepTT[/TD]
[/TR]
[TR]
[TD="align: right"]2[/TD]
[TD]TRUONG THI DIEP[/TD]
[TD]Y[/TD]
[TD]DiepTT1[/TD]
[/TR]
[TR]
[TD="align: right"]3[/TD]
[TD]TRAN TRUONG DIEP[/TD]
[TD]Y[/TD]
[TD]DiepTT2[/TD]
[/TR]
[TR]
[TD="align: right"]4[/TD]
[TD]NGUYEN THI HONG NHUNG[/TD]
[TD]Y[/TD]
[TD]NhungNTH[/TD]
[/TR]
[TR]
[TD="align: right"]5[/TD]
[TD]NGO THI HONG NHUNG[/TD]
[TD]Y[/TD]
[TD]NhungNTH[/TD]
[/TR]
[TR]
[TD="align: right"]6[/TD]
[TD]KIM YOUNG DAM[/TD]
[TD]N[/TD]
[TD]ydKim[/TD]
[/TR]
[TR]
[TD="align: right"]7[/TD]
[TD]Kim Dong Young[/TD]
[TD]N[/TD]
[TD]dykim[/TD]
[/TR]
[TR]
[TD="align: right"]8[/TD]
[TD]Kim Duck Yeon[/TD]
[TD]N[/TD]
[TD]dykim1[/TD]
[/TR]
[TR]
[TD="align: right"]9[/TD]
[TD]HAM KI WON[/TD]
[TD]N[/TD]
[TD]kwham[/TD]
[/TR]
[/TABLE]

 

[phihndhsp]

Chào các bạn,

Có danh sách ví dụ như dưới và yêu cầu là:

1. Nếu là người việt nam thì email phải tạo là Tên (chữ cuối cùng)+ các ký tự đầu tiên của Họ và tên lót
2. Nếu là người nước ngoài thì email phải tạo là Tên (chữ đầu tiên)+ các ký tự đầu tiên của Họ và tên lót
3. Nếu email tạo ra đã tồn tại thì phải thêm số đếm phía sau

Mình viết VBA hoặc lập hàm cho yêu cầu trên nhưng không biết làm, mong được hỗ trợ.

Xin cám ơn.

Quy luật nào bạn? nếu bạn chỉ rõ quy luật chắc chắn tôi sẽ làm ra
NhungNTH đây là email của ai? tại sao có 2 thằng giống nhau
làm sao biết được tên tiếng việt và tên người nước ngoài?

 

[gtri]

Chào các bạn,

Có danh sách ví dụ như dưới và yêu cầu là:

1. Nếu là người việt nam thì email phải tạo là Tên (chữ cuối cùng)+ các ký tự đầu tiên của Họ và tên lót
2. Nếu là người nước ngoài thì email phải tạo là Tên (chữ đầu tiên)+ các ký tự đầu tiên của Họ và tên lót
3. Nếu email tạo ra đã tồn tại thì phải thêm số đếm phía sau

Mình viết VBA hoặc lập hàm cho yêu cầu trên nhưng không biết làm, mong được hỗ trợ.

Xin cám ơn.

Chạy thử đoạn code

Public Sub Tao_EMail()
Dim DL, Tam, kq(), r As Long, c As Long

DL = Sheet1.Range("B2", Sheet1.Range("C1000000").End(xlUp))
ReDim kq(1 To UBound(DL), 1 To 1)

With CreateObject("scripting.dictionary")
For r = 1 To UBound(DL)
DL(r, 1) = Split(DL(r, 1), " ")
Tam = ""

If DL(r, 2) = "Y" Then
For c = 0 To UBound(DL(r, 1)) - 1
Tam = Tam & Left(DL(r, 1)(c), 1)
Next c
Tam = DL(r, 1)(UBound(DL(r, 1))) & Tam
Else
For c = 1 To UBound(DL(r, 1))
Tam = Tam & Left(DL(r, 1)(c), 1)
Next c
Tam = Tam & DL(r, 1)(0)
End If

If Not .exists(Tam) Then
.Add Tam, ""
kq(r, 1) = Tam
Else
.Item(Tam) = Val(.Item(Tam)) + 1
kq(r, 1) = Tam & .Item(Tam)
End If

Next r
End With

Sheet1.Range("F2").Resize(UBound(kq), 1) = kq
End Sub

 

[khanhvc2003]

Woa, đúng là kết quả mình cần nhưng có cách nào áp nó vào giống Công thức luôn.
ví dụ như chổ cột email D2 mình gõ: =Tao_Mail(B2,C2) thì ra kết quả luôn được không bạn ơi!

và kết quả như mong muốn sẽ là: ghi hoa chữ đầu tiên của tên và phần viết tắt ví dụ:
1. ngUoi viet nAM -> NamNV
2. nGUOI nuoc nGOAI ->NguoiNN
3. nGUOI nuoc nGA ->NguoiNN1

Thật sự cám ơn bạn rất nhiều về đoạn code trên.

 

[gtri]

Woa, đúng là kết quả mình cần nhưng có cách nào áp nó vào giống Công thức luôn.
ví dụ như chổ cột email D2 mình gõ: =Tao_Mail(B2,C2) thì ra kết quả luôn được không bạn ơi!

và kết quả như mong muốn sẽ là: ghi hoa chữ đầu tiên của tên và phần viết tắt ví dụ:
1. ngUoi viet nAM -> NamNV
2. nGUOI nuoc nGOAI ->NguoiNN
3. nGUOI nuoc nGA ->NguoiNN1

Thật sự cám ơn bạn rất nhiều về đoạn code trên.

cú pháp =EMail(Ô cần tính, điều kiện)

Public Function EMail(dl, dk As String)
Dim c As Integer
dl = Split(dl, " ")

If UCase(dk) = "Y" Then
For c = 0 To UBound(dl) - 1
EMail = EMail & Left(dl(c), 1)
Next c
EMail = dl(UBound(dl)) & EMail
Else
For c = 1 To UBound(dl)
EMail = EMail & Left(dl(c), 1)
Next c
EMail = EMail & dl(0)
End If

End Function

Số thứ tự khi bị trùng, sẽ dùng kết hợp cùng hàm COUNTIF()
D2=EMail(B2,C2)&IF(COUNTIF($D$11,EMail(B2,C2)&"*")=0,"",COUNTIF($D$11,EMail(B2,C2)&"*"))