判断是否是母子字符串？（字符串有重复，且位置不同）

dsmch

判断规则：母字符串必须包括子字符串的全部字符，且母字符串每个字符的数量大于等于子字符串该字符的数量
如：

3,11,8,1,6,5,11

6,5,3,8,11,1

第一个字符串包括第二个字符串的全部字符；且数量均大于等于
先用字典的方法提供一个思路，望抛砖引玉，希大家提供更好的方法。

1. Function aa(rng1, rng2)
   
2. Set d = CreateObject("scripting.dictionary")
   
3. x = Split(rng1, ",")
   
4. For i = 0 To UBound(x)
   
5.     d(x(i)) = d(x(i)) + 1
   
6. Next
   
7. y = Split(rng2, ",")
   
8. For i = 0 To UBound(y)
   
9.     d(y(i)) = d(y(i)) - 1
   
10. Next
    
11. aa = IIf(InStr(Join(d.items, ","), "-"), "不包含", "包含")
    
12. End Function
    

复制代码

crazy0qwer

这样合并字符，可能效率并不高，自己测试看看。

1. Sub AAA()
   
2.   A = aa("3,11,8,6,5,11", "6,5,3,8,11,1")
   
3. End Sub
   
4. 
   
5. Function aa(Rng1 As String, Rng2 As String) As Boolean
   
6.     Dim X, N As Long
   
7.     X = Split(Rng2, ",")
   
8.     Rng1 = "," & Rng1 & ","
   
9.     N = UBound(X)
   
10.     For I = 1 To N
    
11.         If InStr(Rng1, "," & X(I) & ",") = 0 Then Exit Function
    
12.     Next
    
13.     aa = True
    
14. End Function

复制代码

crazy0qwer

抱歉，看错了。以为是整个字符串长度。
还要比较个数，似乎也没什么好办法。
如果你里面的数不是很大的话，不妨试试用数组来代替字典，比较创建一个数组要比一个对象要快些。
还有就是，如果没有必要的话，还是用按钮一次性判断比较好，因为数据大的话，重算比较耗时。

小花鹿

用你的思路，同时取个巧：
Function bb(rng1, rng2)
Dim ar(99)
x = Split(rng1, ",")
For i = 0 To UBound(x)
    ar(x(i)) = ar(x(i)) + 1
Next
y = Split(rng2, ",")
For i = 0 To UBound(y)
    ar(y(i)) = ar(y(i)) - 1
Next
bb = IIf(InStr(Join(ar, ","), "-"), "不包含", "包含")
End Function

小花鹿

不知用工作表函数是否会被人骂？
Function bb(rng1, rng2)
s = rng2 & ","
x = Split(rng1, ",")
For i = 0 To UBound(x)
    s = Application.Substitute(s, x(i) & ",", "", 1)
Next i
bb = IIf(s <> "", "不包含", "包含")
End Function

考虑不周，改一下：
Function bb(rng1, rng2)
s = "," & rng2 & ","
x = Split(rng1, ",")
For i = 0 To UBound(x)
    s = Application.Substitute(s, "," & x(i) & ",", ",", 1)
Next i
s = Application.Substitute(s, ",", "")
bb = IIf(s <> "", "不包含", "包含")
End Function

bluexuemei

小花鹿 发表于 2013-5-14 01:05
不知用工作表函数是否会被人骂？
Function bb(rng1, rng2)
s = rng2 & ","

学习，很好的思路！

Zamyi

Function aa(rng1, rng2)
Set d = CreateObject("scripting.dictionary")
For Each c In Split(rng1, ",")
  d(c) = d(c) + 1
Next
For Each c In Split(rng2, ",")
  n = d(c)
  If n = 0 Then
    aa = "不包含"
    Exit Function
    Else
    d(c) = n - 1
  End If
Next
aa = "包含"
End Function

bluexuemei

来个RUBY的

1. Sub ruby()
   
2. Dim ojs, x, y
   
3. Set ojs = CreateObject("Scriptcontrol"): ojs.Language = "rubyscript"
   
4. ojs.eval ("s='3,11,8,1,6,5,11';a=s.split(',');b='6,5,3,8,11,1'.split(',')")
   
5. x = ojs.eval("require 'set';Set[*b].subset?(Set[*a])")
   
6. y = ojs.eval("h={};a.each{|x|h[x]=h.key?(x)?h[x]+1:1};b.each{|y|h[y]=h.key?(y)?h[y]-1:1};h")
   
7. MsgBox IIf(InStr(y, "-") = 0 And x, "包含", "不包含")
   
8. ‘Stop
   
9. Set ojs = Nothing
   
10. End Sub

复制代码

bluexuemei

1. Function z(rng1, rng2)
   
2.     Dim ojs, x, y
   
3.     Set ojs = CreateObject("Scriptcontrol"): ojs.Language = "rubyscript"
   
4.     ojs.Eval ("s='" & rng1.Value & "';a=s.split(',');b='" & rng2.Value & "'.split(',')")
   
5.     x = ojs.Eval("require 'set';Set[*b].subset?(Set[*a])")
   
6.     y = ojs.Eval("h={};a.each{|x|h[x]=h.key?(x)?h[x]+1:1};b.each{|y|h[y]=h.key?(y)?h[y]-1:1};h.to_s.include?('-')")
   
7.     z = IIf(Not y And x, "包含", "不包含")
   
8.     Set ojs = Nothing
   
9. End Function
   

复制代码

alzeng

1. Function Yn(str1$, str2$)
   
2.     Set oJs = CreateObject("scriptcontrol"): oJs.Language = "rubyscript"
   
3.     Yn = oJs.Eval("a,b='" & str1 & "'.split(','),'" & str2 & "'.split(',');bl=1;b.uniq" _
   
4.                   & ".each{|o|bl=0 if b.count(o)>a.count(o)};(bl==0?'不':'')+'包含';")
   
5.     Set oJs = Nothing
   
6. End Function

复制代码