Excel自动编号具有相同名称的表

希望大家做得好！ 我有一个关于excel和表名的简单问题。 目前我有一个macros分配到我的模板发票页面上的论坛控制button，单击时将使单元格E7（项目名称）命名复制工作表+单词“发票”在它的末尾。 但是，由于每个项目都会有多个发票，所以我希望macros包含一些代码，如果发现重名，它将自动从两个开始编号。 因此，例如，我使用macros创build“项目A发票”。 如果我再次使用它来创build另一个，我想它被自动命名为“项目A发票（2）”，而不是给我一个错误消息。 以下是我到目前为止：

Sub invoice_export_test() Dim sName As String Dim wks As Worksheet Worksheets("Invoice").Copy after:=Sheets(Worksheets.Count) Set wks = ActiveSheet Do While sName <> wks.Name sName = Range("E7") + " Invoice" wks.Name = sName On Error GoTo 0 Loop Range("C7:D7").Select With Selection.Validation .Delete .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _ :=xlBetween .IgnoreBlank = True .InCellDropdown = True .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True End With ActiveSheet.Shapes.Range(Array("Button 1")).Select Selection.Delete Set wks = Nothing End Sub 

循环之后的所有东西都与这个问题无关（在那里删除了论坛控制button和数据validation），但是我把它包括在内以防万一。 代码可能是凌乱的，因为我不太了解VBA的经验，并使用一些教程来解决这个问题，所以请原谅我哈哈。

先进的感谢您的时间/帮助！

Answer 1

创build一些function来帮助你自己：

 Function GetUniqueName(strProject As String) As String ' If this is the first time it's being used, just return it without a number... If Not SheetNameExists(strProject & " Invoice") Then GetUniqueName = strProject & " Invoice" Exit Function End If ' Otherwise, suffix the sheet name with a number, starting at 2... Dim i As Long, strName As String i = 1 Do i = i + 1 strName = strProject & " Invoice (" & i & ")" Loop While SheetNameExists(strName) GetUniqueName = strName End Function Function SheetNameExists(strName As String) As Boolean Dim sh As Worksheet For Each sh In Worksheets If StrComp(sh.Name, strName, vbTextCompare) = 0 Then SheetNameExists = True Exit Function End If Next End Function 

然后，您可以从以下位置更改代码：

 Dim sName As String Dim wks As Worksheet Worksheets("Invoice").Copy after:=Sheets(Worksheets.Count) Set wks = ActiveSheet Do While sName <> wks.Name sName = Range("E7") + " Invoice" wks.Name = sName On Error GoTo 0 Loop 

至：

 Worksheets("Invoice").Copy after:=Sheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = GetUniqueName(Range("E7"))