VBA: Как использовать RegEx для имен листов в Excel? - PullRequest
0 голосов
/ 10 октября 2019

это мой первый пост здесь. Я пытаюсь создать макрос VBA, в котором лист дублируется несколько раз для последующего использования, и пользователь вводит имя листа с помощью поля ввода. В настоящее время я пытаюсь выяснить, как прервать процесс, если пользователь вводит имя листа, которое уже существует.

Мой текущий план состоит в том, чтобы использовать RegEx, чтобы получить введенную пользователем строку, сопоставить ее свсе листы в рабочей книге и определите, используется ли введенное имя. Вот мой текущий код:

Dim NewSheetName As String

SheetInput: NewSheetName = InputBox("Insert the new sheet name.")

  'Ends procedure if user does not input anything.
    If NewSheetName = "" Then
        Exit Sub
    End If

  'Ends procedure if the sheet name is already in use.
    Dim RegEx As Object
      Set RegEx = CreateObject("VBScript.RegExp")

    With RegEx
        .Pattern = NewSheetName
    End With

    For i = 1 To Sheets.Count
        If RegEx.Test(Sheet(i).Name) = False Then
            MsgBox ("This name is already used on a different sheet.  Please use a different name.")
            GoTo SheetInput
        End If
    Next i

При попытке запустить это, я получаю сообщение «Ошибка компиляции: Sub или Function не определены» с Листом в Sheet(i).Name выделенным. Я предполагал, что имя листа будет введено в функцию RegEx в виде строки, но, похоже, этого не происходит. Может кто-нибудь сказать мне, что с этим не так?

Ответы [ 2 ]

0 голосов
/ 10 октября 2019

Добавление вызова к нескольким пользовательским функциям, которые можно использовать повторно, и реструктуризация вашего кода для использования Do Loop вместо GoTo, см. Следующее:

Public Sub AddNewWrkSht()

    Dim SheetName As String

        SheetName = GetValidSheetName()

    Dim NewWrkSht As Worksheet
    Set NewWrkSht = ThisWorkbook.Worksheets.Add
        NewWrkSht.Name = SheetName

End Sub

Private Function GetValidSheetName() As String

    Dim NewSheetName As String

        'keep asking the user for a valid sheet name
        'until it is valid
        Do
            NewSheetName = InputBox("Insert the new sheet name.")

        Loop Until IsValidSheetName(NewSheetName)

    GetValidSheetName = NewSheetName

End Function


Private Function IsValidSheetName(ByVal SheetName As String) As Boolean

    If IsValueEmpty(SheetName) Then
        MsgBox "You must Provide a sheet Name."
        Exit Function
    End If

    If WorkSheetExists(SheetName) Then

        MsgBox "This name is already used on a different sheet. " & _
               "Please  choose a different name."

        Exit Function
    End If

    'if we make it here without exiting, then the sheet name is valid
    IsValidSheetName = True

End Function

Private Function WorkSheetExists(ByVal SheetName As String) As Boolean
   On Error Resume Next
   WorkSheetExists = Not ActiveWorkbook.Worksheets(SheetName) Is Nothing
End Function


Private Function IsValueEmpty(ByVal varValue As Variant) As Boolean
    IsValueEmpty = (Len(RemoveAllWhiteSpace(varValue)) = 0)
End Function


Private Function RemoveAllWhiteSpace(ByRef varStringIn As Variant, _
                                     Optional ByRef RegExpIn As Object) As String

    'Create if not instantiated
    If RegExpIn Is Nothing Then Set RegExpIn = CreateObject("VBScript.RegExp")

    With RegExpIn
        .Pattern = "\s"
        .MultiLine = True
        .Global = True
        RemoveAllWhiteSpace = CStr(.Replace(varStringIn, vbNullString))
    End With

End Function
0 голосов
/ 10 октября 2019

Есть много способов проверить, существует ли лист. Вот один. Я уверен, что могут быть и лучшие.

Public Function worksheetExists(ByVal wb As Workbook, ByVal sheetNameStr As String) As Boolean

On Error Resume Next
worksheetExists = (wb.Worksheets(sheetNameStr).Name <> "")
On Error GoTo 0

End Function

Вот несколько способов вызвать эту функцию:

If worksheetExists(ThisWorkbook, "sheetNameOne") then ...

If Not worksheetExists(ThisWorkbook, "sheetNameOne") then ...
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...