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以上，但是從您的觀點來看，我認為這不會成為問題