有大神进来帮帮忙的吗？急急急

缄默小宝

就是按照这个表的操作来，能否使用代码 或者公式实现

kkf5560

1. Option Explicit
   
2. 
   
3. Sub MergeNum()
   
4. Dim i&, k&, n&, Res
   
5. i = 2
   
6. Do While Range("a" & i) <> ""
   
7.     If Range("b" & i) <> "" Then
   
8.         k = i + Range("b" & i).MergeArea.Count - 1
   
9.         Res = Range("a" & i).Value
   
10.         For n = i + 1 To k
    
11.             Res = Res & Chr(10) & Range("a" & n)
    
12.         Next n
    
13.         Range("a" & i, "a" & k).Merge
    
14.         Range("a" & i) = Res
    
15.     End If
    
16.     i = k + 1
    
17. Loop
    
18. End Sub

复制代码

answer6141

Range("a14") = Range("a2") & Chr(10) & Range("a3") & Chr(10) & Range("a4") & Chr(10) & Range("a5")

wodewan

附件供参考，结果放在i13
Sub test()
Dim arr, br, i, m, n
arr = Range("a1").CurrentRegion
For i = 1 To UBound(arr)
    If Cells(i, 2).MergeCells Then
        n = n + 1:  m = Cells(i, 2).MergeArea.Count - 1
        br = Range("a" & i & ":a" & i + m)
        arr(n + 1, 1) = Join(Application.Transpose(br), vbCrLf):  arr(n + 1, 2) = Cells(i, 2)
        i = i + m
    End If
Next
[i13].Resize(n + 1, 2) = arr
End Sub

缄默小宝

wodewan 发表于 2020-1-16 17:51
附件供参考，结果放在i13
Sub test()
Dim arr, br, i, m, n

这段代码我运行的成功，但是我真正使用文件的那个代码 我又不知道怎么套了，最后代码运行后的结果是有问题的，主要是H列的那个字段合并内容，其他行跟着合起来

缄默小宝

wodewan 发表于 2020-1-16 17:51
附件供参考，结果放在i13
Sub test()
Dim arr, br, i, m, n

附件在这里，大神帮忙在看看

wodewan

,文件打不开

缄默小宝

wodewan 发表于 2020-1-18 12:28
,文件打不开

我在我的电脑上能打的开 ，这个呢 ，这个里面没放代码

缄默小宝

wodewan 发表于 2020-1-18 12:28
,文件打不开

大神能加你QQ嘛

wodewan

缄默小宝 发表于 2020-1-18 13:28
大神能加你QQ嘛

点那个按钮，生成的结果在sheet1中，我没生成数据，生成后附件超2M发不上来。