请老师用VBA,当两列中，前列最后数与后列最前面数相同时，就合并成一行，谢谢！

cartel

请老师用VBA,当两列中，前列最后数与后列最前面数相同时，就合并成一行，谢谢！.zip (9.23 KB, 下载次数: 9)

2024-2-19 13:25 上传

点击文件名下载附件

ykcbf1100

没看明白，[c2]和[d2]没有相同之处，那[e2]是怎么来的？再有，[c8]为空，[e8]又是怎么来的？

liulang0808

Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    arr = Application.Intersect(Columns("c:d"), ActiveSheet.UsedRange)
    ReDim crr(1 To UBound(arr) * UBound(arr), 1 To 1)
    For j = 1 To UBound(arr)
        If Len(arr(j, 2)) > 0 Then
            x = Left(arr(j, 2), 1)
            If Not d.exists(x) Then
                Set d(x) = CreateObject("scripting.dictionary")
            End If
            d(x)(j) = arr(j, 2)
        Else
            Exit For
        End If
    Next j
    r = 0
    For j = 1 To UBound(arr)
        If Len(arr(j, 1)) > 0 Then
            x = Right(arr(j, 1), 1)
            If d.exists(x) Then
                For Each k In d(x).keys
                    r = r + 1
                    crr(r, 1) = arr(j, 1) & Mid(d(x)(k), 3)
                Next k
            End If
        Else
            Exit For
        End If
    Next j
    [f1].Resize(r) = crr
End Sub

liulang0808

请老师用VBA,当两列中，前列最后数与后列最前面数相同时，就合并成一行，谢谢！.zip (18.63 KB, 下载次数: 6)

2024-2-19 13:40 上传

点击文件名下载附件

附件内容供参考。。。。。。

cartel

liulang0808 发表于 2024-2-19 13:40
附件内容供参考。。。。。。

liulang0808 版主,您好！
感谢版主的代码公式！
我要的是每个数字用逗号分开，还请版主再调下，谢谢！

笨鸟飞不高

请老师用VBA,当两列中，前列最后数与后列最前面数相同时，就合并成一行，谢谢！.zip (15.68 KB, 下载次数: 5)

2024-2-19 14:03 上传

点击文件名下载附件

半百

请测试

ykcbf1100

猜一个吧。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.2.19
   
2.     arr = Me.[c1].CurrentRegion
   
3.     ReDim brr(1 To UBound(arr), 1 To 1)
   
4.     For i = 1 To UBound(arr)
   
5.         If arr(i, 1) <> Empty Then s1 = Right(arr(i, 1), 1)
   
6.         If arr(i, 2) <> Empty Then s2 = Left(arr(i, 2), 1)
   
7.         If s1 = s2 Then
   
8.             m = m + 1
   
9.             brr(m, 1) = arr(i, 1) & Mid(arr(i, 2), 2)
   
10.         End If
    
11.     Next
    
12.     Me.[e1:e1000] = ""
    
13.     Me.[e1].Resize(m, 1) = brr
    
14.     MsgBox "OK！"
    
15. End Sub
    
16. 
    

复制代码

saghj