通过在姓氏上加入名字和几个字符来创建唯一的用户名

Question

我正在编写一个宏来创建唯一的用户名，方法是根据用户名的唯一性加入名字和姓氏的首字母。

例如：

有 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

它没有按我的意愿工作。感谢您对此的帮助。

Answer 1

不错的努力。我已经更改了您的代码并测试了它是否有效。评论很重。

您还应该添加一个检查以查看名称是否为空，如果是则不要输出任何名称。

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