选择中的字符串 从右侧替换字母系列

Question

Sub strreplace()
Dim strArr As Variant
Dim b As Byte

strArr = Array("str.", "strasse", """")

For Each x In Selection
Next

For b = 0 To UBound(strArr)
    Selection.Replace strArr(b), "straße"
Next b

End Sub

上面的代码应该在街道名称示例中找到：Berlinerstr。

（德语中的街道名称）一系列字母（str.）将其替换为 Berlinerstraße 等 Berlinerstrasse 到 Berlinerstraße。

我如何编码从右边第一次出现的 (ss, strasse) 将被替换示例：Lessonstrasse

Lesson...中的字母（ss）不应被替换。

Answer 1

试试这个：

Sub test()

Dim rng As Range, r As Range

Set rng = Range("A1", "A10") 'Adjsut this Range to what ever you need.

For Each r In rng

If Right(r.Value, 4) = "str." Then

    r.Value = Replace(r.Value, "str.", "straße")

ElseIf Right(r.Value, 7) = "strasse" Then

    r.Value = Replace(r.Value, "strasse", "straße")

End If

Next r

End Sub

Answer 2

使用InStrRev 将字符串分成两部分，并在需要的地方插入“ß”。这是一个如何获取字符串中最后一个“ss”的示例 - 您应该能够在现有代码中使用此逻辑：

Sub MM()

Dim names           As Variant
Dim name            As Variant
Dim newName         As String
Dim partA           As String
Dim partB           As String
Const findChar      As String = "ss"
Const replaceChar   As String = "ß"

names = Array("str.", "strasse", "Berlinstrasse", "Lessonstrasse")

For Each name In names
    If InStr(name, findChar) Then
        partA = Left(name, InStrRev(name, findChar) - 1)
        partB = Mid(name, InStrRev(name, findChar) + Len(findChar))
        newName = partA & replaceChar & partB
    End If

    Debug.Print newName

Next

End Sub

---

最终您可以创建一个 UDF 来执行此操作：

Function ReplaceSS(ByVal name As String) As String

    If InStr(name, "ss") Then
        partA = Left(name, InStrRev(name, "ss") - 1)
        partB = Mid(name, InStrRev(name, "ss") + 2)
        newName = partA & "ß" & partB
    Else
        newName = name
    End If

    ReplaceSS = newName

End Function

Answer 3

试试这个

Sub test()

Dim rng As Range, r As Range

Set rng = Range("A1", "A10") 'Adjsut this Range to what ever you need.

For Each r In rng

If InStr(1, r.Value, "strasse") > 0 Then

    r.Value = replace(r.Value, "strasse", "straße")

End If

Next

End Sub

Answer 4

您可以使用StrReverse从字符串的末尾开始，并在Replace method中指定您要进行的最大替换次数：

Public Function Replace(
   ByVal Expression As String,
   ByVal Find As String,
   ByVal Replacement As String,
   Optional ByVal Start As Integer = 1,
   Optional ByVal Count As Integer = -1,
   Optional ByVal Compare As CompareMethod = CompareMethod.Binary
) As String

这是您的代码，替换受限：

Sub strreplace()
Dim strArr As Variant
Dim b As Byte
Dim x As Range

strArr = Array("str.", "strasse", """")

For Each x In Selection.Cells
    For b = 0 To UBound(strArr)
        Cells(x.Row, x.Column) = StrReverse(Replace(StrReverse(x.Value), strArr(b), "straße", 1, 1))
    Next b
Next x
End Sub

Answer 5

这个应该做你想做的事

Sub strReplace()
    Dim strArr As Variant
    Dim b As Byte

    strArr = Array("str.", "strasse", """")

    For Each X In Selection
        For b = 0 To UBound(strArr)
            If InStrRev(X, strArr(b)) > 0 Then
                Selection.Replace X, Left(X, InStrRev(X, strArr(b)) -1) & Replace(X, strArr(b), "straße", InStrRev(X, strArr(b)))
            End If
        Next b
    Next
End Sub

Answer 6

Andrewz，其中一些答案确实很优雅，但你提出的问题是否正确？

作为一名学生，我在因斯布鲁克的 Schneeburggasse 街上度过了美好的一年。尽管我的邻居很令人愉快，但我相信他们会在他们的街道变成 Schneeburggaße 时嗤之以鼻。同样，我的德国笔友曾经住在一条叫做 Schloßstraße 的道路上——如果在您的数据库中记录为 Schlossstrasse，那么 Schlossstraße 看起来不会有点奇怪吗？

我的意思是，仅仅替换最后一个 ss 可能会给你一些非常奇怪的结果。如果没有编写一个极其复杂的语素分析程序来应用已经很脆弱的 Eszett 规则，您将需要一个更可靠的解决方法。

我建议创建一个常用名称的集合，例如 Straße、Schloß 等，您肯定需要替换它们。对它们运行替换，然后存储任何其他出现的 ss 供您循环并手动检查。类似于下面的代码：

Option Explicit
Private mCommonWords As Collection
Private mAmbiguous As Collection

Public Sub RunMe()
    Dim str As String
    Dim cell As Range

    CreateCommonWordList
    ReplaceOrNote

    ' Do anything you like with the list of ambiguous cells
    For Each cell In mAmbiguous
        str = str & cell.Address(False, False) & vbLf
    Next
    MsgBox str
End Sub

Private Sub CreateCommonWordList()
    Set mCommonWords = New Collection
    AddCommonWord "straße", "strasse"
    AddCommonWord "straße", "str."
    AddCommonWord "schloß", "schloss"
End Sub

Private Sub AddCommonWord(correct As String, wrong As String, Optional capitalise As Boolean = True)
    Dim words(1) As String
    Dim splitCorrect(1) As String
    Dim splitWrong(1) As String

    words(0) = correct
    words(1) = wrong
    mCommonWords.Add words
    If capitalise Then
        splitCorrect(0) = UCase(Left(correct, 1))
        splitCorrect(1) = Mid(correct, 2, Len(correct) - 1)
        correct = splitCorrect(0) & splitCorrect(1)
        splitWrong(0) = UCase(Left(wrong, 1))
        splitWrong(1) = Mid(wrong, 2, Len(wrong) - 1)
        wrong = splitWrong(0) & splitWrong(1)
        words(0) = correct
        words(1) = wrong
        mCommonWords.Add words
    End If
End Sub

Private Sub ReplaceOrNote()
    Dim ws As Worksheet
    Dim v As Variant
    Dim startCell As Range
    Dim foundCell As Range

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    ' First replace the common words
    For Each v In mCommonWords
        ws.Cells.Replace _
            What:=v(1), _
            Replacement:=v(0), _
            LookAt:=xlPart, _
            SearchOrder:=xlByRows, _
            MatchCase:=True, _
            SearchFormat:=False, _
            ReplaceFormat:=False
    Next

    ' Now search for every other 'ss' member
    Set mAmbiguous = New Collection
    Set startCell = ws.Cells.Find( _
        What:="ss", _
        After:=ws.Cells(ws.Rows.Count, ws.Columns.Count), _
        LookIn:=xlFormulas, _
        LookAt:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=True)

    If Not startCell Is Nothing Then
        mAmbiguous.Add startCell
        Set foundCell = startCell
        Do
            Set foundCell = ws.Cells.FindNext(foundCell)
            If foundCell Is Nothing Then
                Exit Do
            ElseIf foundCell.Address = startCell.Address Then
                Exit Do
            Else
                mAmbiguous.Add foundCell
            End If
        Loop While True
    End If
End Sub

您好 Ambie，我知道因斯布鲁克很漂亮……您的代码也是如此。我的问题是我必须加载街道地址、邮政编码等 Webfleet。这是一个用于跟踪服务车（地理定位）的在线门户（德语）。如果我在司机终端 TomTom 8275 上上传每日服务之旅，那么如果街道名称以 strasse 结尾，则执行该操作的 excel 工具通常会报告错误（在地理编码上）。 excel工作表中许多地址行的另一个问题以str结尾。 （因斯布鲁克街）。所以我必须把它换成 Insbruckerstraße。我已经测试了你的代码，他解决了这两个问题。但在 Strasserstr。我认为他将其更改为 Straßerstraße 是因为字母系列 strasse 在 strasser 中。好的，我可以忍受...再次感谢