用VBA批量将工作簿中所有工作表特定单元格提取一部分到另一个单元格，并用提取的那个单元格命名工作簿？

Question

求完整代码，工作簿中有很多工作表, 例如A6的内容是"Invoice No.:TAI10029512 TAI10029513 TAI10029514"，提取"TAI10029512"到B6，并用B6的内容"TAI10029512"来命名工作表，谢谢！

Answer 1

如果提取到的B6值有重复，在工作表命名时以B6的值+第几次重复的格式来命名：比如TAI10029512-1、TAI10029512-2

假设A6的字符串中前缀是“Invoice No.:”之类的格式，其中前缀中仅包含1个空格和1个英文输入法下的冒号，另外A6单元格的字符串前端不包含空格，即：没有“    Invoice No.:”之类的格式存在，否则代码中需要增加去除首位空格以及处理大小写冒号的处理

Sub ReNameSht()
Dim d, i%, sr$, s$, sp$, m%
Set d = CreateObject("scripting.dictionary")
For i = 1 To Sheets.Count
With Sheets(i)
sr = .Range("A6")
If Len(sr) Then
s = Split(sr, " ")(1)
sp = Mid(s, InStr(s, ":") + 1, Len(s) - InStr(s, ":"))’以冒号来定位位置
.Range("B6") = sp
If Not d.exists(sp) Then
d(sp) = 1
Debug.Print d(sp)
Else
d(sp) = d(sp) + 1
sp = sp & "-" & d(sp)
m = m + 1
End If
.Name = sp

End If
End With
Next i
MsgBox ("共有" & m & "个工作表明显相重")
d.RemoveAll
End Sub