（请教高手！）单元格内的多个用分号隔开的字符串用另一个表格对应的数值代替

doitbest

长春鱼鱼 发表于 2015-7-14 19:38
还是有个小小问题。部分数值，没有按照首字母A-Z排列阿？

见附件，红色为返回的错误的值。

按顺序排列
Public Sub abc()
Dim ar, rep, i, ii, iii, str, tmp, d
Set d = CreateObject("Scripting.Dictionary")
ar = Range([a2], [a65536].End(3))
Set rep = CreateObject("vbscript.regexp")
rep.Global = True
For i = 1 To UBound(ar)
    rep.Pattern = "\d+#"
    If ar(i, 1) <> "" Then
      ar(i, 1) = rep.Replace(ar(i, 1), "")
      str = Split(ar(i, 1), ";")
      For ii = 0 To UBound(str)
        str(ii) = StrConv(str(ii), 3)
        If IsNumeric(str(ii)) And Not Sheet2.[b:b].Find(str(ii), , , 1) Is Nothing Then
            str(ii) = Sheet2.[b:b].Find(str(ii), , , 1).Offset(, 1)
        End If
        d(str(ii)) = d(str(ii)) + 1
      Next
      For ii = 0 To UBound(str) - 1
        For iii = ii + 1 To UBound(str)
            If str(iii) < str(ii) Then tmp = str(ii): str(ii) = str(iii): str(iii) = tmp
        Next
      Next
      tmp = ""
      For ii = 0 To UBound(str)
          If d(str(ii)) > 1 Then
             d(str(ii) & "@") = d(str(ii) & "@") + 1
              tmp = tmp & "," & str(ii) & d(str(ii) & "@")
          Else
              tmp = tmp & "," & str(ii)
          End If
      Next
      ar(i, 1) = Right(tmp, Len(tmp) - 1)
      tmp = ""
      d.RemoveAll
    End If
Next
[b2].Resize(UBound(ar)) = ar
End Sub

长春鱼鱼

doitbest 发表于 2015-7-14 20:57
按顺序排列
Public Sub abc()
Dim ar, rep, i, ii, iii, str, tmp, d

多谢阿~ 问题解决呢。PERFECT！！

jxwfz740724

留个足迹。