根据条件将字符串连接

书全书店

请教各路神仙，我这个图的内容应该如何做到？
即根据B列的内容，将C列的内容连接在D列内。
求一段代码，并给一段解释，谢谢。

一指禅62

1. Sub 连接字符串()
   
2.     Dim i%, S$
   
3.     Sheet1.Select
   
4.     Range("D:D").ClearContents
   
5.     For i = Range("A65536").End(3).Row To 2 Step -1
   
6.         If Cells(i, 1) = Cells(i - 1, 1) Then
   
7.             S = Cells(i, 3) & "," & S
   
8.         Else
   
9.             S = Cells(i, 3) & "," & S
   
10.             Cells(i, 4) = Left(S, Len(S) - 1)
    
11.             S = ""
    
12.         End If
    
13.     Next
    
14. End Sub

复制代码

duquancai

1. Sub shishi()
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Range("d:d").ClearContents
   
4.     a = Range("b2", Cells(65536, 3).End(3))
   
5.     For i = 1 To UBound(a)
   
6.         If Not d.exists(a(i, 1)) Then d(a(i, 1)) = a(i, 2) Else d(a(i, 1)) = d(a(i, 1)) & "，" & a(i, 2)
   
7.     Next
   
8.     For i = 0 To d.Count - 1
   
9.         Set Rng = Range("b:b").Find(d.keys()(i))
   
10.         If Not Rng Is Nothing Then Rng(1, 3) = d.items()(i)
    
11.     Next
    
12. End Sub

复制代码

一指禅62

代码解释在附件中

zax010

Sub zz()
    Set d = CreateObject("Scripting.Dictionary")
    ar = Range("A1:D" & [a65536].End(3).Row)
    For i = 2 To UBound(ar)
        d(ar(i, 2)) = IIf(d(ar(i, 2)) = "", ar(i, 3), d(ar(i, 2)) & "," & ar(i, 3))
    Next
    For Each k In d.keys
        For i = 2 To UBound(ar)
            If ar(i, 2) = k Then
                ar(i, 4) = d(k): Exit For
            End If
        Next
    Next
    [d1].Resize(UBound(ar)) = Application.Index(ar, 0, 4)
End Sub

zax010

连接字符串样表.rar (13.26 KB, 下载次数: 11)

2017-1-14 19:35 上传

点击文件名下载附件

duquancai

》》》》》》》》》》》》》》》》》》》》》》

书全书店

谢谢各位大神，在学习的路上有各位罩着，真是感激不尽。

excelul

Option Explicit

Sub demo()

Dim rownum As Long, i As Long, y As Long
Dim str1 As String, str2 As String

rownum = Range("B" & Rows.Count).End(xlUp).Row

For i = 2 To rownum Step y
    y = 0
    Do

        str1 = Cells(i, 3).Value
        str2 = str2 & str1 & ","
        i = i + 1
        y = y + 1
    Loop While Cells(i, 2).Value = Cells(i - 1, 2)
    Cells(i - y, 4).Value = str2
    str2 = ""
Next

End Sub

书全书店

excelul 发表于 2017-1-14 23:13
Option Explicit

Sub demo()

你这个简单易懂，谢谢。
可惜我没有想到