VBA编程有偿代做

1256366515

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

能解决一下闭环中 字符个数不确定的问题吗？有可能是7-9个人组成的一个闭环

zxsea_7426

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

这个就是个逻辑问题，怎么就扯上正则了???

疑似良民

1256366515 发表于 2022-3-22 13:27
能解决一下闭环中 字符个数不确定的问题吗？有可能是7-9个人组成的一个闭环

主要程序，上面大神都解决了，你现在就是要求字母可以替换成任意的字符，其实这个很简单，你在后台做一个映射表就行。不一定要在程序里解决这个问题

DevilW

1256366515 发表于 2022-3-22 13:27
能解决一下闭环中 字符个数不确定的问题吗？有可能是7-9个人组成的一个闭环

3个人是利用正则互斥来完成的，要3个人以上的闭环情况复杂许多，需要改变思路了，如第3人流向第1人和第5人流向第1人，应该采取什么机制来决定

1256366515

疑似良民 发表于 2022-3-22 14:51
主要程序，上面大神都解决了，你现在就是要求字母可以替换成任意的字符，其实这个很简单，你在后台做一个 ...

现在最主要的问题并非，替换成字符的问题。而是一个闭环中可能是3个字符组成，也可能是4个，9个字符组成；这段代码默认三个字符组成

1256366515

DevilW 发表于 2022-3-22 15:27
3个人是利用正则互斥来完成的，要3个人以上的闭环情况复杂许多，需要改变思路了，如第3人流向第1人和第5 ...

3个人只是最低的层级的闭环，大神能重新帮忙写一下吗

1256366515

zxsea_7426 发表于 2022-3-22 13:45
这个就是个逻辑问题，怎么就扯上正则了???

如果不用正则怎么解决呢 ，闭环可能有3个人组成，也可能四个人组成，甚至最大可能8个九个人组成

笨鸟飞不高

VBA编写程序，寻找所有闭环.zip (18.86 KB, 下载次数: 8)

2022-3-22 16:41 上传

点击文件名下载附件

microyip

提供一个不限制字数的找闭环的算法予以参考

1. Private vData As Variant, nRow As Long, dicData As Object
   
2. 
   
3. Sub CloseLink()
   
4.     With [A1].CurrentRegion
   
5.         vData = .Offset(1).Resize(.Rows.Count - 1).Value
   
6.     End With
   
7.     Set dicData = CreateObject("Scripting.Dictionary")
   
8.     For nRow = 1 To UBound(vData)
   
9.         If vData(nRow, 1) <> "" And vData(nRow, 2) <> "" Then
   
10.             If Not dicData.Exists(vData(nRow, 1)) Then Set dicData(vData(nRow, 1)) = CreateObject("Scripting.Dictionary")
    
11.             dicData(vData(nRow, 1))(vData(nRow, 2)) = ""
    
12.         End If
    
13.     Next
    
14.     ReDim vData(0)
    
15.     nRow = 0
    
16.    
    
17.     GetLink dicData
    
18.     [D:D].ClearContents
    
19.     If nRow > 0 Then [D1].Resize(nRow) = Application.WorksheetFunction.Transpose(vData)
    
20. End Sub
    
21. 
    
22. Private Function GetLink(ByVal oDic As Object, Optional ByVal sFirst As String, Optional ByVal sLink As String)
    
23.     Dim vKey As Variant, vDataKey As Variant
    
24.    
    
25.     For Each vKey In oDic.Keys
    
26.         If vKey = sFirst And Len(sLink & vKey) > 2 Then
    
27.             nRow = nRow + 1
    
28.             ReDim Preserve vData(1 To nRow)
    
29.             vData(nRow) = sLink & vKey
    
30.         ElseIf Not (sLink Like "*" & vKey & "*") Then
    
31.             If dicData.Exists(vKey) Then GetLink dicData(vKey), IIf(sFirst = "", vKey, sFirst), sLink & vKey
    
32.         End If
    
33.     Next
    
34. End Function

复制代码

microyip

附上附件以供参考