通过在名字上join名字和几个字符来创build唯一的用户名

我正在编写一个macros来创build一个唯一的用户名,通过join名字和姓氏的第一个字母取决于用户名的唯一性。

例如:

有3个名字:

  1. ABCD,2.ABCD,3.ABCD

还有3个姓氏:

  1. QWER,2.QWER,3.QWER。

用户名应该是:

  1. ABCDQ@somewhere.com,2.ABCDQW@somewhere.com,3.ABCDQWE@somewhere.com。

为了得到这个,我在VBA上写了下面的代码,

Sub Create_User_Name() Dim fName As String Dim lName As String Dim uName As String Dim eMail As String Dim preFname As String Dim preLname As String Dim preUname As String Dim fNameCol As Integer Dim fNameRow As Integer Dim lNameCol As Integer Dim lNameRow As Integer Dim rowNumber As Integer Dim leftVal As Integer 'For loop starting here to increment row number For rowNumber = 2 To 7802 fNameCol = 1 fNameRow = rowNumber lNameCol = 2 lNameRow = rowNumber fName = Worksheets("Sheet1").Cells(fNameRow, fNameCol) lName = Worksheets("Sheet1").Cells(lNameRow, lNameCol) preFname = Worksheets("Sheet1").Cells(fNameRow - 1, fNameCol) preLname = Worksheets("Sheet1").Cells(lNameRow - 1, lNameCol) eMail = "" & "somewhere.com" leftVal = 1 uName = fName + Left(lName, leftVal) + "@" + eMail preUname = preFname + Left(preLname, leftVal) + "@" + eMail If UCase(uName) = UCase(preUname) Then Do While uName = preUname uName = fName + Left(lName, leftVal) + "@" + eMail preUname = preFname + Left(preLname, leftVal) + "@" + eMail leftVal = leftVal + 1 rowNumber = rowNumber + 1 Loop uName = fName + Left(lName, leftVal) + "@" + eMail preUname = preFname + Left(preLname, leftVal) + "@" + eMail Worksheets("Sheet1").Cells(rowNumber, 3).Value = uName Else Worksheets("Sheet1").Cells(rowNumber, 3).Value = uName End If Next rowNumber End Sub 

这不是我想要的。 感谢你的帮助。

不错的努力。 我已经改变了你的代码,并testing它的工作原理。 评论相当重要。

你也应该添加一个检查,看看这个名字是否为空,如果是的话,不要输出任何名字。

 Sub Create_User_Name() Dim fName As String Dim lName As String Dim uName As String Dim eMail As String Dim preUname As String Dim fNameCol As Long Dim fNameRow As Long Dim lNameCol As Long Dim lNameRow As Long Dim rowNumber As Long Dim leftVal As Long 'For loop starting here to increment row number For rowNumber = 2 To 7802 'Gets Column Data fName = Worksheets("Sheet1").Cells(rowNumber, 1) lName = Worksheets("Sheet1").Cells(rowNumber, 2) 'Sets the @email part of string eMail = "" & "somewhere.com" 'Sets the amount of characters for the last name leftVal = 1 'sets the unique number to add to the end if the username exist increment it addUniqueNo = 1 'sets up the username uName = fName + Left(lName & addUniqueNo, leftVal) + "@" + eMail 'sets up the check username preUname = uName 'Until the username is unique Do While UCase(uName) = UCase(preUname) 'Sets the username (including the unique number if required) uName = fName + Left(lName & addUniqueNo, leftVal) + "@" + eMail 'Checks if the username already exists With Worksheets(1).Range("C:C") Set c = .Find(uName, LookIn:=xlValues) 'If username doesnt exist change comparison string to not match If c Is Nothing Then preUname = "" Else 'If username does exist update the preUname to match (to ensure it loops again) preUname = uName End If End With 'Adds each character to the end until there are no more then adds a number starting at 1 If leftVal > (Len(lName) + 1) Then addUniqueNo = addUniqueNo + 1 Else leftVal = leftVal + 1 End If Loop 'Outputs the username Worksheets("Sheet1").Cells(rowNumber, 3) = uName Next rowNumber End Sub