比较列表并replace工作表名称

我有一个包含2列“全名”（AA，BB，CC等）和“电子邮件地址”（123 @ test.com，321 @ test.com等）的工作表（“转储”）。

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

我需要一个VBA脚本将工作表名称与“转储”表中的“全名”列进行比较，只有在工作表名称与“全名”匹配的情况下，才将工作表名称replace为“电子邮件地址” AA（全名）= AA（工作表名称）。

我有代码取代“全名”与“电子邮件地址”没有validation。

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

你可以做这样的事情（未经testing）：

 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 

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