VBA编程有偿代做

1256366515

问题在附件Excel中，谢谢

microyip

这是组合逻辑，N的组合，N-1组合……3组合

DevilW

1256366515

DevilW 发表于 2022-3-21 21:18

大神您好，该程序有以下问题：1、将字母替换成其他符号，结果不能生成（这是最大的问题）
2、无法剔除重复的闭环 比如ABBCCA  和BCCAAB（这一条可以不解决）

1256366515

DevilW 发表于 2022-3-21 21:18

1、将字母替换成其他符号，结果不能生成（这条是最大的问题）
2、无法剔除重复的闭环 比如ABBCCA  和BCCAAB（这个可以不解决）
3、字母（字母）也就是供应商客户的总数可能多达60个

DevilW

DevilW

1. Sub test()
   
2.     Set d = CreateObject("scripting.dictionary") '字典声明
   
3.     Set reg = CreateObject("vbScript.Regexp") '正则声明
   
4.     reg.Global = True
   
5.     reg.Pattern = "(\S)(?!\1)(\S)\2(?!\2)(\S)\3(?!\3)\1" '可视字符关键字
   
6.     ar = [a2:b8]
   
7.     n = UBound(ar)
   
8.     ReDim s(1 To n)
   
9.     Dim sn(1 To 3)
   
10.     For i = 1 To n
    
11.         s(i) = ar(i, 1) & ar(i, 2) '记录客户供应商流向
    
12.     Next
    
13.     For i = 1 To n
    
14.         For j = 1 To n
    
15.             For k = 1 To n
    
16.                 sn(1) = s(i) & s(j) & s(k) '任三流向排列
    
17.                 If reg.test(sn(1)) Then '则符合闭环则列出
    
18.                     sn(2) = s(j) & s(k) & s(i) 'sn2-sn3同向顺序排列
    
19.                     sn(3) = s(k) & s(i) & s(j)
    
20.                     m = 0
    
21.                     For h = 1 To 3
    
22.                         If d.exists(sn(h)) Then m = 1 '字典已有同向则标记
    
23.                     Next
    
24.                     If m = 0 Then d(sn(1)) = "" '无重复则字典记录
    
25.                 End If
    
26.             Next
    
27.         Next
    
28.     Next
    
29.     Debug.Print Join(d.keys, Chr(10))
    
30. End Sub

复制代码

1256366515

DevilW 发表于 2022-3-22 11:47

1、重复的问题解决了，把字母替换成其他字符（汉字后者字母加数字）还是行不通2、这只适用于3个级次，最大环可能有4个，5个字母组成

DevilW

1256366515 发表于 2022-3-22 12:36
重复的问题解决了，把字母替换成其他字符还是行不通

单个字符吗？必须是可视的字符，图片上 for h =1 to 6 改为 1 to 3

1256366515

DevilW 发表于 2022-3-22 12:42
单个字符吗？必须是可视的字符，图片上 for h =1 to 6 改为 1 to 3

请大神再帮忙看看 字符的问题我可以用数值，大小写，等代替；
但是一个闭环不止是由三个字符组成，还可能4个，5个字符组成