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

我正在写一个宏，根据用户名的唯一性，将名字和姓氏的第一个字母连接起来，创建一个唯一的用户名

例如：

有3个名字：

ABCD，2.ABCD，3.ABCD

还有三个姓：

QWER，2.QWER，3.QWER 用户名应为：

ABCDQ@somewhere.com2.ABCDQW@somewhere.com3.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

---

这不是我想要的。谢谢你在这方面的帮助

做得不错。我已经更改了你的代码，并测试了它的工作原理。我的评论很重

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

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

---

不错的努力。我已经更改了你的代码，并测试了它的工作原理。我的评论很重

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

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

---

“它没有按照我的意愿工作”是一个通用的问题描述，适用于任何问题。请更具体一点：告诉我们你假装你的代码应该做什么以及它实际做了什么。“它没有按照我的意图工作”是一个通用的问题描述，对于任何问题都是正确的。请更具体一点：告诉我们你假装你的代码应该做什么以及它实际做什么。谢谢@ClintB。这正是我想要的。再次感谢你的帮助。你救了我一天。：）：）谢谢@ClintB。这正是我想要的。再次感谢你的帮助。你救了我一天。：）：）