Question

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

例如：

有3个名字：

ABCD，2.ABCD，3.ABCD

还有3个姓氏：

QWER，2.QWER，3.QWER。

用户名应为：

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

通过连接姓氏和姓氏上的多个字符来创建唯一的用户名

1 个答案: