A、B列进行比较，并进行空行处理，谢谢taller、醉眼看尘世老师！

lhj323323

老师：


求助.rar (15.41 KB, 下载次数: 14)

2024-10-3 13:26 上传

点击文件名下载附件

我想实现的效果，请看下图


老师如有空，请帮忙看看，先谢谢了！

ynzsvt

原有A、b列单列内不重复且a、b相同的连线的话不交叉。能满足？

taller

1. Sub Demo()
   
2.     Dim i As Long, j As Long
   
3.     Dim arrData, rngData As range
   
4.     Dim arrRes, iR As Long, a, b
   
5.     Set oDicA = CreateObject("scripting.dictionary")
   
6.     Set oDicB = CreateObject("scripting.dictionary")
   
7.     Set rngData = ActiveSheet.range("A1").CurrentRegion
   
8.     arrData = rngData.value
   
9.     ReDim arrRes(1 To UBound(arrData) * 2, 1)
   
10.     iR = iR + 1
    
11.     arrRes(iR, 0) = arrData(1, 1)
    
12.     arrRes(iR, 1) = arrData(1, 2)
    
13.     ia = 1: iB = 1
    
14.     For i = LBound(arrData) + 1 To UBound(arrData)
    
15.         sKey = arrData(i, 1)
    
16.         If Len(sKey) > 0 Then oDicA(sKey) = ""
    
17.         sKey = arrData(i, 2)
    
18.         If Len(sKey) > 0 Then oDicB(sKey) = ""
    
19.     Next
    
20.     Do While oDicA.Count + oDicB.Count > 0
    
21.         If oDicA.Count Then a = oDicA.Keys()(0) Else a = ""
    
22.         If oDicB.Count Then b = oDicB.Keys()(0) Else b = ""
    
23.         If a = b Then
    
24.             iR = iR + 1
    
25.             arrRes(iR, 0) = a
    
26.             arrRes(iR, 1) = a
    
27.             oDicA.Remove (a)
    
28.             oDicB.Remove (b)
    
29.         ElseIf oDicB.exists(a) Or a = "" Or (Len(a) > 0 And b < a) Then
    
30.             iR = iR + 1
    
31.             arrRes(iR, 0) = ""
    
32.             arrRes(iR, 1) = b
    
33.             oDicB.Remove (b)
    
34.         ElseIf oDicA.exists(b) Or b = "" Or (Len(b) > 0 And a < b) Then
    
35.             iR = iR + 1
    
36.             arrRes(iR, 0) = a
    
37.             arrRes(iR, 1) = ""
    
38.             oDicA.Remove (a)
    
39.         End If
    
40.     Loop
    
41.     [H1].Resize(iR, 2).value = arrRes
    
42. End Sub
    
43. 
    

复制代码

taller

lhj323323

ynzsvt 发表于 2024-10-3 13:47
原有A、b列单列内不重复且a、b相同的连线的话不交叉。能满足？

什么意思？
我没看懂。

lhj323323

taller 发表于 2024-10-3 14:16

对，那几行，我没有处理了
不好意思，误导老师了
我正在抄代码。

taller

lhj323323 发表于 2024-10-3 14:31
对，那几行，我没有处理了
不好意思，误导老师了
我正在抄代码。

我发的代码正在审核中

醉眼看尘世

好久不用，练练手，怕忘了

lhj323323

taller 发表于 2024-10-3 14:38
我发的代码正在审核中

没关系，老师
反正在呆在家里
也该多输入，增加手感

刚才，测试了
完全正确！

lhj323323

taller 发表于 2024-10-3 14:16

之前，我有过类似的求助贴，运行成功了的，（但涉及正则，完全搞不懂）
今天早上，套用那段代码
乱改一通，最终运行报错
所以只得硬着头皮再来求助。