VBA：根据单元格地址将变量设置为范围

Question

I have the following code:

Sub findReplace()
Dim myArray As Variant, rng As Range, str As Variant, cAdd2 As Range


myArray = Array("è", "é", "ë", "ê", "í", "?", "ñ", "ò", "ó", "ô", "ö", "à", "ã", "á", "Á", "ä", "ü", "â", "ø", "š", "??", ">", "<", "+", "*", "^", "ß", "ç", "å", "æ", ".", ";", "#", ":", "'", "-", "@", "Ã", "¨", "É", "Ô", "[", "]", "Ó", "Ñ", "(", ")", "Ö")

Set rng = Workbooks("User").Sheets("Result").Range("B2:B10")


For Each cell In rng
    cAdd = cell.Address
    Set cAdd2 = Range(cell.Address)
    For Each str In myArray
        If InStr(cell, str) Then
            cAdd2.Offset(, 1).Formula = "=Substitute(" & cAdd & ", " & str & ",""_"")"   -->**# This is where I get my error**
        Else
            cAdd2.Offset(, 1) = "=(" & cAdd & ")"
        End If
    Next str
Next cell


End Sub

What I want to be able to do is go through a range of cells, replace any characters that are in my array in that cell with an underscore in the cell next to it, and if there is no special characters, then just copy it over.

I believe the problem is with the cell.Address function, but I'm not sure.

Any suggestions is highly appreciated!

Thanks!

Answer 1

Can you give this a try. Will also allow for replacements of more then one character

Sub findReplace()
    Dim myArray As Variant, rng As Range, str As Variant
    Dim Form As String

    myArray = Array("è", "é", "ë", "ê", "í", "?", "ñ", "ò", "ó", "ô", "ö", "à", "ã", "á", "Á", "ä", "ü", "â", "ø", "š", "??", ">", "<", "+", "*", "^", "ß", "ç", "å", "æ", ".", ";", "#", ":", "'", "-", "@", "Ã", "¨", "É", "Ô", "[", "]", "Ó", "Ñ", "(", ")", "Ö")

    Set rng = Workbooks("User").Sheets("Result").Range("B2:B10")

    For Each cell In rng
        Form = "=(" & cell.Address & ")"

        For Each str In myArray
            If Not str = vbNullString Then
                If InStr(cell, str) Then
                    If Len(Form) > 0 Then
                        Form = Replace(Form, cell.Address, "Substitute(" & cell.Address & ", """ & str & """,""_"")")  ' -->**# This is where I get my error**
                    Else
                        Form = "=Substitute(" & cell.Address & ", """ & str & """,""_"")"
                    End If
                End If
            End If
        Next str
        cell.Offset(, 1).Formula = Form
    Next cell
End Sub

Answer 2

The error with that line is in my comments but this will be quicker, as it only has one loop and will replace every special character and not just the last found as @Flephal stated:

Sub findReplace()
Dim myArray As Variant, rng As Range, str As Variant


myArray = Array("è", "é", "ë", "ê", "í", "?", "ñ", "ò", "ó", "ô", "ö", "à", "ã", "á", "Á", "ä", "ü", "â", "ø", "š", "??", ">", "<", "+", "*", "^", "ß", "ç", "å", "æ", ".", ";", "#", ":", "'", "-", "@", "Ã", "¨", "É", "Ô", "[", "]", "Ó", "Ñ", "(", ")", "Ö")

Set rng = Workbooks("User").Sheets("Result").Range("B2:B10")

rng.Offset(, 1).Value = rng.Value
For Each str In myArray
    rng.Offset(, 1).Replace str, "_"
Next str

End Sub

---

Test:

Sub findReplace()
Dim myArray As Variant, rng As Range, str As Variant


myArray = Array("E", "S", "!", ")")
Set rng = ActiveSheet.Range("B2:B10")

rng.Offset(, 1).Value = rng.Value
For Each str In myArray
    rng.Offset(, 1).Replace str, "_"
Next str

End Sub