[已解决]物料代替

wjd1163

除了运算符号，将公式内的物料用A、B、C…代替，此公式怎样写？(物料上万种）

最佳答案

月排行榜 / 总排行榜

爱疯

2015-7-22 10:27

Function repl(rng As Range)
    Dim d, reg, matchs, match, k, t, s$, i%

    '找出匹配项（即物料），生成替换项
    s = rng.Text
    Set reg = CreateObject("VBScript.RegExp")
    Set d = CreateObject("scripting.dictionary")
    With reg
        .Global = True
        .Pattern = "[\u4E00-\u9FA5]+"
        Set matchs = .Execute(s)

        For Each match In matchs
            If Not d.exists(match.Value) Then
                i = i + 1
                d(match.Value) = Chr(i + 64)
            End If
        Next
    End With
    k = d.keys: t = d.items
    Set d = Nothing: Set reg = Nothing

    '排序。如果让字符串长度短的先替换，则可能结果出错
    Call SelectionSort(k, t)

    '替换
    For i = 0 To UBound(k)
        s = VBA.Replace(s, k(i), t(i))
    Next i
    repl = s
End Function


Sub SelectionSort(arr, brr)
    Dim i, j, t, k
    For i = LBound(arr) To UBound(arr) - 1
        k = i
        For j = i + 1 To UBound(arr)
            If Len(arr(k)) < Len(arr(j)) Then k = j    '降序：字符长的放前面
        Next
        If k <> i Then
            t = arr(k): arr(k) = arr(i): arr(i) = t
            t = brr(k): brr(k) = brr(i): brr(i) = t
        End If
    Next
End Sub

代替2.rar (14.96 KB, 下载次数: 10)

2015-7-22 10:26 上传

点击文件名下载附件

先试下。

跳转到最佳答案楼层

爱疯

汽水和水，都替换为A，是对的？

wjd1163

爱疯 发表于 2015-7-21 22:38
汽水和水，都替换为A，是对的？

是的,第一次出现的物料为A(不论那个计算都是一样),第二次出现为B,类推下去

爱疯

3楼明白了。

1）“物料上万种”
是指有上万行的数据？
还是指一个单元格里有上万个物料？

2）当物料超过26种，第27种如何表示？

3）用VBA做可以吗？

wjd1163

爱疯 发表于 2015-7-21 23:11
3楼明白了。

1）“物料上万种”

一个计算式内不同的物料不会超过20种,"物料上万种"是指上万种的物料组成不同的计算式
用VBA也可以,最好用用公式做

爱疯

Function repl(rng As Range)
    Dim d, reg, matchs, match, k, t, s$, i%

    '找出匹配项（即物料），生成替换项
    s = rng.Text
    Set reg = CreateObject("VBScript.RegExp")
    Set d = CreateObject("scripting.dictionary")
    With reg
        .Global = True
        .Pattern = "[\u4E00-\u9FA5]+"
        Set matchs = .Execute(s)

        For Each match In matchs
            If Not d.exists(match.Value) Then
                i = i + 1
                d(match.Value) = Chr(i + 64)
            End If
        Next
    End With
    k = d.keys: t = d.items
    Set d = Nothing: Set reg = Nothing

    '排序。如果让字符串长度短的先替换，则可能结果出错
    Call SelectionSort(k, t)

    '替换
    For i = 0 To UBound(k)
        s = VBA.Replace(s, k(i), t(i))
    Next i
    repl = s
End Function


Sub SelectionSort(arr, brr)
    Dim i, j, t, k
    For i = LBound(arr) To UBound(arr) - 1
        k = i
        For j = i + 1 To UBound(arr)
            If Len(arr(k)) < Len(arr(j)) Then k = j    '降序：字符长的放前面
        Next
        If k <> i Then
            t = arr(k): arr(k) = arr(i): arr(i) = t
            t = brr(k): brr(k) = brr(i): brr(i) = t
        End If
    Next
End Sub

代替2.rar (14.96 KB, 下载次数: 10)

2015-7-22 10:26 上传

点击文件名下载附件

先试下。

李建军

留个记号~~

wjd1163

爱疯 发表于 2015-7-22 10:27
Function repl(rng As Range)
    Dim d, reg, matchs, match, k, t, s$, i%

能公式能不能做到呀？？

爱疯

我觉得需求对于公式来说，太复杂，做不了。

245747772

爱疯 发表于 2015-7-22 21:06
我觉得需求对于公式来说，太复杂，做不了。

帮忙看看 http://www.excelpx.com/thread-367927-1-1.html