Макрос Excel для принудительного ввода верхнего регистра и удаления специальных символов нажатием кнопки

Question

У меня есть 2 кода, но только один работает в VBA.У меня есть

Private Sub FINALIZEBTN_Click()

Dim response As VbMsgBoxResult
response = MsgBox("HAVE YOU COMPLETED THE FORM IN FULL?", vbYesNo)
If response = vbYes Then
    MsgBox "DO NOT FORGET TO SAVE AND SUBMIT THIS FORM"
    Else
If response = vbNo Then
    MsgBox "PLEASE REVIEW AND COMPLETE THE FORM IN FULL"
    Exit Sub
End If
End If

Dim cell As Range
    For Each cell In Range("$A$1:" & Range("$A$1").SpecialCells(xlLastCell).Address)
        If Len(cell) > 0 Then cell = UCase(cell)
    Next cell

    Application.ScreenUpdating = True
End Sub

Так что при нажатии вы получаете приглашение да / нет, тогда оно вызывает прописные буквы на всем листе.

Единственными символами, которые мы разрешаем, являются '&' и '-' Я бы хотел, чтобы при вводе специального символа появлялось другое окно, сообщающее им что-то вроде «эй, ты не можешь этого сделать» или когданайден специальный символ, чтобы удалить его и просто удалить его ничем.Если бы мы могли заставить его удалять и заменять латинские буквы острыми (как для испанского языка), это было бы также здорово.В настоящее время я не вижу никаких изменений при сохранении или запуске макросов с кодом в модуле 1.

У меня есть следующий код в модуле 1

Function removeSpecial(sInput As String) As String
    Dim sSpecialChars As String
    Dim i As Long
    sSpecialChars = "\/:*?""<>|$,.`"
    For i = 1 To Len(sSpecialChars)
        sInput = Replace$(sInput, Mid$(sSpecialChars, i, 1), "")
    Next
    removeSpecial = sInput
End Function

Answer 1

Как уже говорили другие, вам нужно позвонить на removeSpecial.

Тем не менее, я бы переписал removeSpecial, чтобы указать символы, которые вы хотите сохранить, поскольку существует гораздо больше специальных символов, чем то, что вы перечислили в removeSpecial

Другие изменения

• Используйте SpecialCells xlCellTypeConstants только для циклического перебора ячеек, содержащих значения (устраняет необходимость в проверке Len и исключает формулы).
• Счет для листа возможностей не имеет постоянных значений
• Добавлена ​​замена акцентированных символов: вам нужно будет расширить строки ReplaceFrom и ReplaceWith, чтобы включить все нужные замены (убедитесь, что эти две строки имеют одинаковую длину)
• Вы можете (или не можете) включать другие символы во включение, например, пробел или другие знаки пунктуации? Если это так, добавьте их к шаблону sKeepChars Like (оставьте - в качестве первого символа внутри, затем []
• Все сообщения CAPS ужасны!

---

Function removeSpecial(sInput As String) As String
    Dim sKeepChars As String
    Dim sClean As String
    Dim c As String
    Dim i As Long, j As Long
    Const ReplaceFrom As String = "AE"
    Const ReplaceWith As String = "ÀÊ"

    sKeepChars = "[-&A-Z" & ReplaceWith & "]"
    For i = 1 To Len(sInput)
        c = Mid$(sInput, i, 1)
        If c Like sKeepChars Then
            j = InStr(ReplaceFrom, c)
            If j Then
                c = Mid$(ReplaceWith, j, 1)
            End If
            sClean = sClean & c
        End If
    Next
    removeSpecial = sClean
End Function


Private Sub FINALIZEBTN_Click()
    Dim response As VbMsgBoxResult
    response = MsgBox("Have you completed the form in full?", vbYesNo)
    If response = vbYes Then
        MsgBox "Do not forget to save and submit this form"
    ElseIf response = vbNo Then
        MsgBox "Please review and complete the form in full"
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Dim cell As Range
    Dim rng As Range
    With ActiveSheet
        On Error Resume Next
            Set rng = .Cells.SpecialCells(xlCellTypeConstants)
        On Error GoTo 0
        If Not rng Is Nothing Then
            For Each cell In rng
                cell = removeSpecial(UCase(cell))
            Next cell
        End If
    End With
    Application.ScreenUpdating = True
End Sub

Answer 2

Это должно работать нормально:

    Dim MyStr As String
    For Each cell In Range("$A$1:" & Range("$A$1").SpecialCells(xlLastCell).Address)
        If Len(cell) > 0 Then
            MyStr = cell
            cell = UCase(removeSpecial(MyStr))
        End If
    Next cell