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 символ.

Итак, я хотел бы получить некоторые рекомендации о том, как добавить цифру в конец имени листа, а затем повторить процесс, чтобы увидеть, существует ли это имя листа, а затем переместить его вверх на число и затем проверить еще раз.

Заранее спасибо

Andy

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

Edit: Чтобы удалить недопустимые символы и сохранить имя листа до 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, но, как вы сказали, я не думаю, что это будет проблемой