Excel VBA 检查 sheet 是否存在，如果存在，将数字添加到 sheet 名称

Question

我想说我是 Excel VBA 的中级用户，但我正在为这个而苦苦挣扎。

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

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

当我第一次编写代码时，我打算在 sheet 名称中添加一个时间，但它有时会使名称超过 31 个字符的限制。

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

提前致谢

安迪

Answer 1

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 以上，但从你的说法来看，我认为这不会成为问题

Answer 2

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

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

代码中有一个过程和两个函数：
第一个是您的代码的副本（声明了变量）。
第二个计算出 sheet.
的名称第三个检查 sheet 是否存在。

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

编辑： 要删除非法字符并将 sheet 名称保留为 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

Excel VBA 检查 sheet 是否存在，如果存在，将数字添加到 sheet 名称

Excel VBA check if sheet exists and if yes add numeric to sheet name

excel

vba

worksheet