Vba 比较列表并替换工作表名称

我有一个工作表（“转储”），有两列“全名”（AA、BB、CC等）和“电子邮件地址”(123@test.com,321@test.com等）

整个Excel包含200多个工作表（命名为AA、BB、CC等）

我需要一个VBA脚本将工作表名称与“转储”工作表中的“全名”列进行比较，并且仅当工作表名称与“全名”匹配时，才将工作表名称替换为“电子邮件地址”，即仅当AA（全名）=AA（工作表名称）时才替换

我有代码可以在未经验证的情况下将“全名”替换为“电子邮件地址”

Sub replace()
    Dim arr As Variant
    arr = Range("A2:A5").Value
    For i = LBound(arr) To UBound(arr)
        Sheets(i + 1).Activate
        Sheets(i).Name = arr(i, 1)
    Next i
End Sub

---

谢谢：）

您可以这样做（未经测试）：

---

这假设您的全名在A列，从第2行开始，电子邮件地址在B列。

如果这很复杂，请以其他方式帮助我。如果验证为真，即如果AA（全名）=AA（工作表名），我只需要将特定工作表作为电子邮件发送。这非常有效。只需删除底部第4行的“；”）谢谢trincot:）太好了！事实上，这个分号不属于那里。我现在把它拆了。如果您同意，请接受答案（参见左上角的标志）。

Sub replace()
    Dim col As New Collection
    Dim cell As Range
    Dim sh As WorkSheet

    ' Step 1: Create a dictionary that maps names to emails
    For Each cell in Sheets("Dump").Range("A2:A999")
        If cell.value = "" Then Exit For ' no more names
        col.Add cell.Offset(0, 1).value, cell.value
    Next
    ' Step 2: Go through all sheets and rename them
    For Each sh in Sheets
        sh.Activate ' not really necessary, but it gives some visual clue
        On Error Resume Next ' ignore mismatch errors
            sh.Name = col.Item(sh.Name) ' replace name by email
        On Error Goto 0
    Next
End Sub