Excel宏强制使用大写并通过单击按钮删除特殊字符

我有两个代码，但只有一个在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

因此，在单击时，您会得到一个“是/否”提示，然后它会强制在整个工作表中使用大写字母

我们只允许使用“&”和“-” 我希望在输入一个特殊字符时弹出另一个框，告诉他们“嘿，你不能这样做”，或者当发现一个特殊字符要删除它时，就什么也不删除它。如果我们能让它删除拉丁字母并用acutes替换（就像西班牙语一样），那也太好了。目前，在使用模块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

函数将特殊（输入为字符串）删除为字符串
将特殊字符设置为字符串
我想我会坚持多久
SSSpecialChars=“\/：*？”“|$，.”
对于i=1至Len（特殊字符）
sInput=替换$（sInput，Mid$（SSSpecialChars，i，1），“”）
下一个
removeSpecial=sInput
端函数

这应该可以正常工作：

    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

---

正如其他人所说，您需要调用

removeSpecial

这就是说，我将重写

removeSpecial

以指定要保留的字符，因为这里的特殊字符比您在

removeSpecial

其他变化

• 使用

  xlCellTypeConstants

  仅循环包含值的单元格（无需测试

  Len

  并排除公式）
• 可能性表的科目没有常量值
• 添加了重音字符替换：您需要扩展

  ReplaceFrom

  和

  ReplaceWith

  字符串，以包括所有需要的替换（确保这两个字符串的长度相同）
• 您可能（也可能不）希望在包含内容中包含其他字符，例如空格或其他标点符号？如果是这样，将它们添加到

  sKeepChars

  模式中（将

  -

  保留为第一个字符，然后将

  []

• 所有的CAPS消息都很难看

---

---

这是一个函数，您必须像这样在主过程中调用它：

removeSpecial（YourTextOrStringVariableHere）

所以我可以在

Dim单元格上调用它作为范围内每个单元格的范围（“$a$1:”&Range（$a$1”）。特殊单元格（xlLastCell）。地址）如果Len（cell）>0，那么cell=UCase（cell）按钮代码的下一个单元格

部分？如果是的话，它会去哪里？第一个单元格没有做任何事情。第二个单元格给我一个编译错误：ByRef参数类型不匹配，并且它标记了

单元格=RemoveSpecial（单元格）

portionHmm…试着给它

cell.value

或

cell.text

如此接近，现在我们得到了一个运行时424对象所需的错误然后，将名为…

MyStr的变量声明为String

然后给

MyStr

cell.value并用

MyStr

调用函数，最后

cell=MyStrFunction 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