vba replace all in column within sections broken b

2019-09-19 23:48发布

So I have some code that goes through a list of names (most are one username per row). A few of the row have multiple names broken up by the "/" character (John Doe / Smith Jr / Some Guy). I use the following code (repeated per name case) in order to modify all names to a proper LDAP name.

Worksheets(2).Columns("B").Replace _
What:="*smith*", Replacement:="jsmith", _
SearchOrder:=xlByColumns, MatchCase:=False

Worksheets(2).Columns("B").Replace _
What:="*Doe*", Replacement:="jdoe", _
SearchOrder:=xlByColumns, MatchCase:=False

This worked for every field that only has a single name entry. Is there a way specify to remove John Doe with the wildcard "*" charcters (some fields may not be spelt correctly etc), but to not modify anything past "/".

Example data

John Doe
Abraham Lincoln / john_doe
doe john
doe john / Obiwan
john doe / jsmith / mark mane
john smith / john doe
john does

Expected Output

jdoe
Abraham Lincoln / jdoe 
jdoe
jdoe / Obiwan
jdoe / joe smith / mark mane
jsmith / jdoe
jdoe

What I am receiving

jdoe
jdoe
jdoe
jdoe
jdoe
jsmith
jdoe

2条回答
在下西门庆
2楼-- · 2019-09-20 00:20

Try this:

What:="/*Doe*/", Replacement:="/jdoe/"

And add a trailing / to each cell in the range so it catches entries like some name / john doe

查看更多
地球回转人心会变
3楼-- · 2019-09-20 00:22

This should also work, and doesn't require prefix/suffix anything. This processes 100K cells in about 6 seconds (per call to the foo function).

Sub main()
' This is your main procedure and you can specify all _
  of your replacements here on their own line:

Call foo("*Doe*", "jdoe")
Call foo("*Ruth*", "bruth")
Call foo("*Washington*", "gwashington")
' etc...

End Sub

Sub foo(replace, replacement)
Dim rng As Range, cl As Range, vals

Set rng = Worksheets(2).Range("B1:B100000")  'Modify as needed
For Each cl In rng.Cells
    vals = Split(cl.Value, " / ")
    For i = LBound(vals) To UBound(vals)
        If vals(i) Like replace Then
            vals(i) = replacement
        End If
    Next
    cl.Value = Join(vals, " / ")
Next


End Sub
查看更多
登录 后发表回答