Excel VBA检查工作表是否存在，如果是，则将数字添加到工作表名称

Question

我想说我是Excel VBA的中间用户，但我正在努力解决这个问题。

我编写了一个脚本来读取文本文件并删除我需要的所有信息，然后将其添加到由文本文件名称命名的工作表中，然后添加到今天的日期。

Set WS1 = ActiveWorkbook.Sheets("Home")
myFile = Application.GetOpenFilename()
myFileName = FileNameOf(myFile)
WS1.Copy After:=Sheets(Sheets.Count)
Set WS2 = ActiveSheet
strNewSheetName = myFileName & " - " & Format(Now, "DD-MM-YY")
blnSheetCheck = CheckIfSheetExists(strNewSheetName)
If blnSheetCheck = True Then
    blnDeleteSheet = MsgBox("NOTICE:" & vbCrLf & vbCrLf & "This text file has already been added today!!" & vbCrLf & vbCrLf & "would you like to delete the existing one?", vbYesNo + vbCritical)
    If blnDeleteSheet = vbYes Then
        ActiveWorkbook.Sheets(strNewSheetName).Delete
        WS2.Name = strNewSheetName
    Else
    ' Roll the number here
    End If
Else
    WS2.Name = strNewSheetName
End If

我用这个函数来检查它是否存在

Function CheckIfSheetExists(SheetName) As Boolean

CheckIfSheetExists = False
Err.Clear
On Error Resume Next
Set WS99 = Sheets(SheetName)
If Err = 0 Then
    CheckIfSheetExists = True
Else
    CheckIfSheetExists = False
End If

End Function

当我第一次编写代码时，我将为工作表名称添加时间，但有时会将名称超过31个字符的限制。

所以我想要一些关于如何在工作表名称的末尾添加数字，然后重复该过程以查看该工作表名称是否存在然后将其向上移动一个数字然后再次检查的指导。

先感谢您

安迪

Answer 1

这会将工作表命名为，例如： Test 03-05-18然后Test 03-05-18_01到Test 03-05-18_99。

更新此行以允许更多副本： TempShtName = SheetName & "_" & Format(lCounter, "00")

代码中有一个过程和两个函数： 第一个是代码的副本（带变量声明）。 第二个数字显示了工作表的名称。 第三个检查表单是否存在。

Public Sub Test()

    Dim WrkBk As Workbook
    Dim WS1 As Worksheet, WS2 As Worksheet
    Dim myFile As String
    Dim myFileName As String

    myFile = Application.GetOpenFilename()

    'File name including extension:
    'myFileName = Mid(myFile, InStrRev(myFile, "\") + 1)

    'File name excluding extension:
    myFileName = Mid(myFile, InStrRev(myFile, "\") + 1, InStrRev(myFile, ".") - InStrRev(myFile, "\") - 1)

    With ThisWorkbook
        Set WS1 = .Sheets("Home")
        WS1.Copy After:=.Worksheets(.Worksheets.Count)

        Set WS2 = .Worksheets(.Worksheets.Count)
        WS2.Name = GetSheetName(myFileName & " - " & Format(Now, "dd-mm-yy"))
    End With

End Sub

'Return a numbered sheet name (or the original if it's the first).
Public Function GetSheetName(SheetName As String, Optional WrkBk As Workbook) As String

    Dim wrkSht As Worksheet
    Dim TempShtName As String
    Dim lCounter As Long

    If WrkBk Is Nothing Then
        Set WrkBk = ThisWorkbook
    End If

    TempShtName = SheetName
    Do While WorkSheetExists(TempShtName)
        lCounter = lCounter + 1
        TempShtName = SheetName & "_" & Format(lCounter, "00")
    Loop

    GetSheetName = TempShtName

End Function

'Check if the sheet exists.
Public Function WorkSheetExists(SheetName As String, Optional WrkBk As Workbook) As Boolean
    Dim wrkSht As Worksheet

    If WrkBk Is Nothing Then
        Set WrkBk = ThisWorkbook
    End If

    On Error Resume Next
        Set wrkSht = WrkBk.Worksheets(SheetName)
        WorkSheetExists = (Err.Number = 0)
        Set wrkSht = Nothing
    On Error GoTo 0

End Function

编辑：要删除非法字符并将工作表名称保留为31个字符，您可以在GetSheetName行之前的TempShtName = SheetName函数中添加此代码：

Dim x As Long
Dim sChr As String
Const ILLEGAL_CHR As String = "\/*?:[]"

For x = 1 To Len(SheetName)
    sChr = Mid(SheetName, x, 1)
    If InStr(ILLEGAL_CHR, sChr) > 0 Then
        SheetName = Replace(SheetName, sChr, "_")
    End If
Next x
If Len(SheetName) > 28 Then
    SheetName = Left(SheetName, 28)
End If

Answer 2

Set WS1 = ActiveWorkbook.Sheets("Home")
myFile = Application.GetOpenFilename()
myFileName = FileNameOf(myFile)
WS1.Copy After:=Sheets(Sheets.Count)
Set WS2 = ActiveSheet
strNewSheetName = myFileName & " - " & Format(Now, "DD-MM-YY")
blnSheetCheck = CheckIfSheetExists(strNewSheetName)
If blnSheetCheck = True Then
    blnDeleteSheet = MsgBox("NOTICE:" & vbCrLf & vbCrLf & "This text file has already been added today!!" & vbCrLf & vbCrLf & "would you like to delete the existing one?", vbYesNo + vbCritical)
    If blnDeleteSheet = vbYes Then
        ActiveWorkbook.Sheets(strNewSheetName).Delete
        WS2.Name = strNewSheetName
    Else
     '======Here's the new bit=================
       Dim x as integer
       x = 1
       Do
           strnewsheetname = left(strnewsheetname,30) & x
           blnSheetCheck = CheckIfSheetExists(strNewSheetName)
           x = x +1
       Loop while blnSheetCheck
       WS2.Name = strNewSheetName
    '=============End of New Bit=============
    End If

Else
    WS2.Name = strNewSheetName
End If

从技术上讲，这将保持在9以上，但从你说过我不认为这将是一个问题