Question

希望每个人都做得好！我有一个关于excel和工作表名称的快速问题。目前，我的模板发票页面上有一个分配给论坛控制按钮的宏，点击后会生成一个以单元格E7（项目名称）+单词＆＃34; Invoice＆＃34;在它的最后。但是，由于每个项目将有多个发票，我希望宏包含一些代码，如果它找到重复的名称，它将自动开始从两个编号。例如，我使用宏来创建＆＃34;项目A发票＆＃34;。如果我再次使用它来创建另一个，我希望它被命名为＆＃34;项目A发票（2）＆＃34;自动而不是给我一个错误信息。这就是我到目前为止所拥有的：

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

循环之后的所有内容与此问题无关（它在那里删除论坛控制按钮和数据验证），但我包括它以防万一。代码可能很乱，因为我对VBA没有太多经验并且使用了一些教程来解决这个问题，所以请原谅我这个哈哈。

先谢谢您的时间/帮助！

Answer 1

创建一些功能来帮助自己：

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"))

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

1 个答案: