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

Question

我有一个工作表（“转储”）与2列“全名”（AA，BB，CC等）和“电子邮件地址”（123 @ test.com，321 @测试.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 

谢谢:)

Answer 1

你可以做这样的事情（未测试）：

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 

这里假设你有充分的名字在A列，开始第2行，并B列中的电子邮件地址。