求助大神，多单元格数据合并到到一个单元格内

老虎咬刺猬

各位大神，弄了好久始终也没弄出来，我想把附件表格中“汇总表“相关的机会点和分享点，分别合并到评估表的指定位置，比如："汇总sheet"中的D列数据，合并到评估表的F4位置，要求合并后的每条信息按顺序在前面自带序号，或者每条中间有"、”去分隔，谢谢啦

liulang0808

Sub 按钮1_Click()
    r = Sheets("汇总").Cells(Rows.Count, 4).End(3).Row
    arr = Sheets("汇总").[d5].Resize(r - 4)
    str1 = ""
    For j = 1 To UBound(arr)
        If Len(arr(j, 1)) > 0 Then
            str1 = str1 & "、" & arr(j, 1)
        End If
    Next j
    If Len(str1) > 0 Then
        Sheets("系统稽核评估表").[f4] = Mid(str1, 2)
    Else
        Sheets("系统稽核评估表").[f4] = ""
    End If
End Sub

liulang0808

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

凌空一羽

Sub lkyy()
Set d = CreateObject("Scripting.Dictionary")
ar = Sheets("汇总").Range("d4:d24")
For i = 2 To UBound(ar)
    If ar(i, 1) <> "" Then s = s & "、" & ar(i, 1)
Next
s = Mid(s, 2, 99999)
Sheets("系统稽核评估表").[f4] = s
Set d = Nothing
End Sub

老虎咬刺猬

liulang0808 发表于 2020-1-20 21:10
附件内容供参考。。。。。。

多谢老师

老虎咬刺猬

凌空一羽 发表于 2020-1-20 21:16
Sub lkyy()
Set d = CreateObject("Scripting.Dictionary")
ar = Sheets("汇总").Range("d4:d24")

多谢大神~~

老虎咬刺猬

liulang0808 发表于 2020-1-20 21:09
Sub 按钮1_Click()
    r = Sheets("汇总").Cells(Rows.Count, 4).End(3).Row
    arr = Sheets("汇总"). ...

老师，麻烦再问下，如果合并过来的数据只有1条或者为空，就会报错，因为不能用“、“号分隔，这个应该怎么弄呀

liulang0808

老虎咬刺猬 发表于 2020-1-21 12:12
老师，麻烦再问下，如果合并过来的数据只有1条或者为空，就会报错，因为不能用“、“号分隔，这个应该怎 ...

Sub 按钮1_Click()
    r = Sheets("汇总").Cells(Rows.Count, 4).End(3).Row
    arr = Sheets("汇总").[d5].Resize(r)
    str1 = ""
    For j = 1 To UBound(arr)
        If Len(arr(j, 1)) > 0 Then
            str1 = str1 & "、" & arr(j, 1)
        End If
    Next j
    If Len(str1) > 0 Then
        Sheets("系统稽核评估表").[f4] = Mid(str1, 2)
    Else
        Sheets("系统稽核评估表").[f4] = ""
    End If
End Sub

老虎咬刺猬

liulang0808 发表于 2020-1-21 13:04
Sub 按钮1_Click()
    r = Sheets("汇总").Cells(Rows.Count, 4).End(3).Row
    arr = Sheets("汇总" ...

多谢，非常好用，谢谢！