VBA中的多次替换

Question

如何替换工作表中的多个单词？

类似的词：Da...da、Do...do、Dos、De...de.. 等

如何在名为“Customers3”的电子表格中调整它？

Public Function MyProper(MyString As String, Optional exceptions As Variant)

Dim c As Variant
If IsMissing(exceptions) Then
    exceptions = Array("a", "as", "e", "o", "os", "da", "das", "de", "di", "do", "dos",  _
      "CPF", "RG", "E-Mail")
End If

MyString = Application.Proper(MyString)

For Each c In exceptions
    MyString = Replace(" " & MyString & " ", " " & c & " ", " " & LCase(c) & " ", , , vbTextCompare)
Next c

MyProper = MyString

End Sub

Answer 1

这里有一个问题：

MyString = Replace(" " & MyString & " ", " " & c & " ", " " & LCase(c) & " ", , , vbTextCompare)

每次通过循环时，您都会添加更多空格...

你还有End Sub而不是End Function

试试这个：

Public Function MyProper(MyString As String, Optional exceptions As Variant)

    Dim c As Variant
    If IsMissing(exceptions) Then
        exceptions = Array("a", "as", "e", "o", "os", "da", _
                           "das", "de", "di", "do", "dos", _
                           "CPF", "RG", "E-Mail")
    End If
    
    MyString = " " & Application.Proper(MyString) & " " 'in case exception at start/end
    
    For Each c In exceptions
        MyString = Replace(MyString, " " & c & " ", " " & LCase(c) & " ", , , vbTextCompare)
    Next c
    
    MyProper = Trim(MyString) 'remove any added spaces

End Function

Answer 2

Proper葡萄牙语

Option Explicit

Function MyProper(ByVal MyString As String) As String

    Const ExceptionsList As String _
        = "a,as,e,o,os,da,das,de,di,do,dos,CPF,RG,E-Mail"
    Dim Exceptions() As String: Exceptions = Split(ExceptionsList, ",")
    
    Dim SubStrings() As String
    SubStrings = Split(Application.Proper(MyString), " ")
    
    Dim cIndex As Variant
    Dim n As Long
    For n = 0 To UBound(SubStrings)
        cIndex = Application.Match(SubStrings(n), Exceptions, 0)
        If IsNumeric(cIndex) Then
            SubStrings(n) = Exceptions(cIndex - 1)
        End If
    Next n
    
    MyProper = Join(SubStrings, " ")

End Function


Sub MyProperAllWorksheets()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet
    Dim rg As Range
    Dim Data As Variant
    Dim rCount As Long, cCount As Long
    Dim r As Long, c As Long
    
    For Each ws In wb.Worksheets
        Set rg = ws.UsedRange
        rCount = rg.Rows.Count
        cCount = rg.Columns.Count
        If rCount > 1 Or cCount > 1 Then
            Data = rg.Value
        Else
            ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
        End If
        For r = 1 To rCount
            For c = 1 To cCount
                On Error Resume Next
                Data(r, c) = MyProper(Data(r, c))
                On Error GoTo 0
            Next c
        Next r
        rg.Value = Data
    Next ws

End Sub