[已解决]sheet之间按条件替换单元格部分文本的问题

loyo_single

请问各位前辈，假如sheet1中的单元格里有‘A,B,C,D’等值，sheet2中有2列，一列是原名称，一列是新名称，如，原名称 A ，新名称为 A0；
所以sheet1中的‘A,B,C,D’则改成‘A0，B,C,D’请问，如何根据sheet2中的对应表，去替换sheet1中的值，谢谢指点。

附件中附有文档和效果表

比如sheet1中一列单元格的值：

名称列

A,B,C,D

A,E,F,B

B,F,G,A

F,W,E,A

........

sheet2中

原名称    新名称

A              A0

B             B2

C             E0

D             D12

F             F1

G            G5

....................

等

备注：sheet2中原名称为sheet1中的名称，

现在要把sheet1中的名称，根据sheet2中的原名称和新名称的对应关系，把sheet1中的名称替换成 sheet2中的新名称。

如替换后的sheet1为：

  名称列

A0,B2,E0,D12

A0,E,F1,B2

B2,F1,G5,A0

F1,W,E,A0

.....................

麻烦大家指点迷津。谢谢，稽首作揖

[此贴子已经被作者于2009-12-23 9:10:22编辑过]

最佳答案

月排行榜 / 总排行榜

1970-1-1 08:00

跳转到最佳答案楼层

喜多多

用excel附件更容易理解你的意思

loyo_single

QUOTE:

以下是引用喜多多在2009-12-21 12:26:00的发言：
用excel附件更容易理解你的意思

附件已上传，谢谢您，麻烦大家给 指点指点

amulee

正则+字典：
Sub Test()
    On Error Resume Next
    Dim ArrD, ArrYS, i&
    Dim RegEx As Object, MyA As Object, sTemp
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
    '建立字典
    ArrD = Sheet2.Range("A2:B" & Sheet2.Range("A65536").End(xlUp).Row)
    For i = 1 To UBound(ArrD, 1)
        d(ArrD(i, 1)) = ArrD(i, 2)
    Next i
    '建立正则表达式对象
    Set RegEx = CreateObject("VBScript.RegExp")    'RegEx为建立正则表达式
    RegEx.Global = True
    RegEx.Pattern = Join(d.keys, "|")
    '原始数组
    ArrYS = Sheet1.Range("A2:A" & Sheet1.Range("A65536").End(xlUp).Row)
    For i = 1 To UBound(ArrYS, 1)
        Set MyA = RegEx.Execute(ArrYS(i, 1))
        For Each sTemp In MyA
            ArrYS(i, 1) = RegEx.Replace(ArrYS(i, 1), d(CStr(sTemp)))
        Next sTemp
    Next i
    Sheet1.Range("A2").Resize(UBound(ArrYS, 1), UBound(ArrYS, 2)) = ArrYS
    Set RegEx = Nothing
    Set d = Nothing
End Sub

loyo_single

QUOTE:

以下是引用amulee在2009-12-21 13:39:00的发言：
正则+字典：
Sub Test()
    On
  Error
  Resume
  Next
    Dim ArrD, ArrYS, i&
    Dim RegEx As
  Object, MyA As
  Object, sTemp
    Dim d As
  Object
    Set d = CreateObject("Scripting.Dictionary")
    '建立字典
    ArrD = Sheet2.Range("A2:B" & Sheet2.Range("A65536").End(xlUp).Row)
    For i = 1 To
  UBound(ArrD, 1)
        d(ArrD(i, 1)) = ArrD(i, 2)
    Next i
    '建立正则表达式对象
    Set RegEx = CreateObject("VBScript.RegExp")    'RegEx为建立正则表达式
    RegEx.Global = True
    RegEx.Pattern = Join(d.keys, "|")
    '原始数组
    ArrYS = Sheet1.Range("A2:A" & Sheet1.Range("A65536").End(xlUp).Row)
    For i = 1 To
  UBound(ArrYS, 1)
        Set MyA = RegEx.Execute(ArrYS(i, 1))
        For
  Each sTemp In MyA
            ArrYS(i, 1) = RegEx.Replace(ArrYS(i, 1), d(CStr(sTemp)))
        Next sTemp
    Next i
    Sheet1.Range("A2").Resize(UBound(ArrYS, 1), UBound(ArrYS, 2)) = ArrYS
    Set RegEx = Nothing
    Set d = Nothing
End
  Sub

非常感谢你，按您的方法我通过了测试，谢谢，先又有一新问题，能否再帮我看看？

[此贴子已经被作者于2009-12-23 9:12:31编辑过]

amulee

两个都叫胶片的，怎么区分A还是B？

loyo_single

QUOTE:

以下是引用amulee在2009-12-22 10:35:00的发言：
两个都叫胶片的，怎么区分A还是B？

呵呵，胶片都是A，粘贴错了，不好意思[em01]

amulee

老办法，稍作修改
Sub Test()
    On Error Resume Next
    Dim ArrD, ArrYS, i&
    Dim RegEx As Object, MyA As Object, sTemp
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
    '建立字典
    ArrD = Sheet2.Range("B2:C" & Sheet2.Range("A65536").End(xlUp).Row)
    For i = 1 To UBound(ArrD, 1)
        d(ArrD(i, 1)) = IIf(ArrD(i, 2) = "A", 2, IIf(ArrD(i, 2) = "B", 3, 4))
    Next i
    '建立正则表达式对象
    Set RegEx = CreateObject("VBScript.RegExp")    'RegEx为建立正则表达式
    RegEx.Global = True
    '原始数组
    ArrYS = Sheet1.Range("A2:D" & Sheet1.Range("A65536").End(xlUp).Row)
    For i = 1 To UBound(ArrYS, 1)
        RegEx.Pattern = Join(d.keys, "|")
        Set MyA = RegEx.Execute(ArrYS(i, 1))
        For Each sTemp In MyA
            ArrYS(i, 1) = RegEx.Replace(ArrYS(i, 1), "")
            ArrYS(i, d(CStr(sTemp))) = sTemp
        Next sTemp
        '多余的逗号
        RegEx.Pattern = "，，"
        ArrYS(i, 1) = RegEx.Replace(ArrYS(i, 1), "，")
        RegEx.Pattern = "^，|，$"
        ArrYS(i, 1) = RegEx.Replace(ArrYS(i, 1), "")
    Next i
    Sheet1.Range("A2").Resize(UBound(ArrYS, 1), UBound(ArrYS, 2)) = ArrYS
    Set RegEx = Nothing
    Set d = Nothing
End Sub

loyo_single

QUOTE:

以下是引用amulee在2009-12-22 11:33:00的发言：
老办法，稍作修改
Sub Test()
    On
  Error
  Resume
  Next
    Dim ArrD, ArrYS, i&
    Dim RegEx As
  Object, MyA As
  Object, sTemp
    Dim d As
  Object
    Set d = CreateObject("Scripting.Dictionary")
    '建立字典
    ArrD = Sheet2.Range("B2:C" & Sheet2.Range("A65536").End(xlUp).Row)
    For i = 1 To
  UBound(ArrD, 1)
        d(ArrD(i, 1)) = IIf(ArrD(i, 2) = "A", 2, IIf(ArrD(i, 2) = "B", 3, 4))
    Next i
    '建立正则表达式对象
    Set RegEx = CreateObject("VBScript.RegExp")    'RegEx为建立正则表达式
    RegEx.Global = True
    '原始数组
    ArrYS = Sheet1.Range("A2:D" & Sheet1.Range("A65536").End(xlUp).Row)
    For i = 1 To
  UBound(ArrYS, 1)
        RegEx.Pattern = Join(d.keys, "|")
        Set MyA = RegEx.Execute(ArrYS(i, 1))
        For
  Each sTemp In MyA
            ArrYS(i, 1) = RegEx.Replace(ArrYS(i, 1), "")
            ArrYS(i, d(CStr(sTemp))) = sTemp
        Next sTemp
        '多余的逗号
        RegEx.Pattern = "，，"
        ArrYS(i, 1) = RegEx.Replace(ArrYS(i, 1), "，")
        RegEx.Pattern = "^，|，$"
        ArrYS(i, 1) = RegEx.Replace(ArrYS(i, 1), "")
    Next i
    Sheet1.Range("A2").Resize(UBound(ArrYS, 1), UBound(ArrYS, 2)) = ArrYS
    Set RegEx = Nothing
    Set d = Nothing
End
  Sub

呵呵，这个刚才用数据测试通过了，我刚才没把问题描述清楚，这样的，要提取的单元格里，往往不止一个提取元素，比如A1中，电视机和电脑都属于B类别，符合提取条件，都得提取，所以提前出来后，放在一个单元格里，用符号隔开，如 电视机，电脑。  

[

[此贴子已经被作者于2009-12-23 9:11:43编辑过]

loyo_single

另外一个就是，比如台式电视机，提取的时候，不能只提取电视机，剩下‘台式’了。呵呵。只有在SHEET2对应中完全对应才提取。