其助如何取消合并单元格并在下方插入空行合并内容

jian82372387

需求：遍历A列单元格，发现有合并单元格的在下方插入一个空行，合并单元格取消，原合并单元格A列的内容改为原来的数字+字母A和加字母B的组合，插入的行A列单元格仍复制之前单元格的数字，后续插入空行B-G列（B5-G5等于B3-G3&B4-G4的内容）相应上两行的内容连接，插入的空行 H列等于前行的和列(即为H5=H3+H4的和）

LIUZHU

合并单元格会有超过两行的情况么？即变成2A、2B、2C...

jian82372387

LIUZHU 发表于 2024-3-27 11:24
合并单元格会有超过两行的情况么？即变成2A、2B、2C...

没有，最多两行

LIUZHU

这个效果，是不是需要的？

LIUZHU

JSA代码，供参考

1. function 数据整理(){
   
2.         Sheets.Item("表1").Activate();
   
3.         let arr=Range("a1").CurrentRegion.Value2;
   
4.         let key,obj={},res=[arr[0]];
   
5.         arr.slice(1).forEach(x=>{
   
6.                 if (x[0]!=null) key=x[0];
   
7.                 let temp=obj[key]=obj[key] || [];
   
8.                 temp.push(x);
   
9.         });
   
10.         for (key in obj){
    
11.                 let temp=obj[key];
    
12.                 if (temp.length>1){
    
13.                         let tp=[key,...Array(arr[0].length-2).fill(""),0];
    
14.                         temp.forEach((x,i)=>{
    
15.                                 x[0]=key+"AB"[i];
    
16.                                 for (let j=1;j<tp.length;j++) tp[j]+=x[j];
    
17.                         });
    
18.                         temp.push(tp);
    
19.                 }
    
20.                 res.push(...temp)
    
21.         }
    
22.         Range("k1").Resize(res.length,res[0].length).Value2=res;
    
23. }

复制代码

LIUZHU

需要用WPS测试，Office不行

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.3.27
   
2.     Application.ScreenUpdating = False
   
3.     With Sheets("表1")
   
4.         arr = .UsedRange
   
5.         ReDim brr(1 To 10000, 1 To UBound(arr, 2))
   
6.         m = 0
   
7.         For i = 2 To UBound(arr)
   
8.             If .Cells(i, 1).MergeCells Then
   
9.                 r = i: st = arr(i, 1)
   
10.                 m = m + 3
    
11.                 brr(m - 2, 1) = st & "A"
    
12.                 brr(m - 1, 1) = st & "B"
    
13.                 brr(m, 1) = arr(r, 1)
    
14.                 For j = 2 To UBound(arr, 2)
    
15.                     brr(m - 2, j) = arr(r, j)
    
16.                     brr(m - 1, j) = arr(r + 1, j)
    
17.                     brr(m, j) = arr(r, j) & arr(r + 1, j)
    
18.                 Next
    
19.                 brr(m, UBound(arr, 2)) = arr(r, UBound(arr, 2)) + arr(r + 1, UBound(arr, 2))
    
20.                 i = i + 1
    
21.             Else
    
22.                 m = m + 1
    
23.                 For j = 1 To UBound(arr, 2)
    
24.                     brr(m, j) = arr(i, j)
    
25.                 Next
    
26.             End If
    
27.         Next
    
28.     End With
    
29.     With Sheets("结果")
    
30.         .[a2:h10000].Clear
    
31.         .[a1].Resize(1, UBound(arr, 2)).Interior.Color = 49407
    
32.         With .[a2].Resize(m, UBound(arr, 2))
    
33.             .Value = brr
    
34.             .Borders.LineStyle = 1
    
35.             .HorizontalAlignment = xlCenter  '//列居中
    
36.             .VerticalAlignment = xlCenter
    
37.         End With
    
38.     End With
    
39.     Application.ScreenUpdating = True
    
40.     MsgBox "OK！"
    
41. End Sub
    

复制代码

jian82372387

ykcbf1100 发表于 2024-3-27 13:26
参与一下。。。

感谢帮忙，想请教一下，我根据另外的需求修改了一下代码，为啥我计算出来的结果不对的，就是结果工作表里的J5单元格的值错误，我所需正确的结果如L10单元格我用函数计算出来了，请问代码问题具体出在哪里了？


代码如下：

Sub ykcbf()  '//2024.3.27
    Application.ScreenUpdating = False
    With Sheets("原始数据")
        arr = .UsedRange
        ReDim brr(1 To 10000, 1 To UBound(arr, 2))
        m = 0
        For i = 2 To UBound(arr)
            If .Cells(i, 1).MergeCells Then
                r = i: st = arr(i, 1)
                m = m + 3
                brr(m - 2, 1) = st & "A"
                brr(m - 1, 1) = st & "B"
                brr(m, 1) = arr(r, 1)
                For j = 2 To UBound(arr, 2)
                    If j = 2 Then
                      brr(m - 2, j) = arr(r, j)
                      brr(m - 1, j) = arr(r + 1, j)
                      brr(m, j) = arr(r, j)
                    ElseIf j = 10 Then
                      brr(m - 2, j) = arr(r, j)
                      brr(m - 1, j) = arr(r + 1, j)
                      brr(m, j) = TimeValue(arr(r, 2)) + (arr(r, j) + arr(r + 1, j)) / 24
                     ElseIf j = 9 Then
                      brr(m - 2, j) = arr(r, j)
                      brr(m - 1, j) = arr(r + 1, j)
                      brr(m, j) = arr(r, j) + arr(r + 1, j)
                    Else
                      brr(m - 2, j) = arr(r, j)
                      brr(m - 1, j) = arr(r + 1, j)
                      brr(m, j) = arr(r, j) & "/" & arr(r + 1, j)
                    End If
                Next
                brr(m, UBound(arr, 2)) = arr(r, UBound(arr, 2)) + arr(r + 1, UBound(arr, 2))
                i = i + 1
            Else
                m = m + 1
                For j = 1 To UBound(arr, 2)
                    brr(m, j) = arr(i, j)
                Next
            End If
        Next
    End With
    With Sheets("结果")
        .[a2:k10000].Clear
        .[a1].Resize(1, UBound(arr, 2)).Interior.Color = 49407
        With .[a2].Resize(m, UBound(arr, 2))
            .Value = brr
            .Borders.LineStyle = 1
            .HorizontalAlignment = xlCenter  '//列居中
            .VerticalAlignment = xlCenter
        End With
    End With
    Application.ScreenUpdating = True
    MsgBox "OK！"
End Sub

jian82372387

ykcbf1100 发表于 2024-3-27 13:26
参与一下。。。

请教个问题，我根据另外的需求修改了一下代码，为什么J5单元格的值计算错误不是我想要的值，具体L5单元格正确的值如L10单元格我用函数算出来的，请问代码哪里有问题啊？？


具体代码如下：

Sub ykcbf()  '//2024.3.27
    Application.ScreenUpdating = False
    With Sheets("原始数据")
        arr = .UsedRange
        ReDim brr(1 To 10000, 1 To UBound(arr, 2))
        m = 0
        For i = 2 To UBound(arr)
            If .Cells(i, 1).MergeCells Then
                r = i: st = arr(i, 1)
                m = m + 3
                brr(m - 2, 1) = st & "A"
                brr(m - 1, 1) = st & "B"
                brr(m, 1) = arr(r, 1)
                For j = 2 To UBound(arr, 2)
                    If j = 2 Then
                      brr(m - 2, j) = arr(r, j)
                      brr(m - 1, j) = arr(r + 1, j)
                      brr(m, j) = arr(r, j)
                    ElseIf j = 10 Then
                      brr(m - 2, j) = arr(r, j)
                      brr(m - 1, j) = arr(r + 1, j)
                      brr(m, j) = TimeValue(arr(r, 2)) + arr(r, j) / 24 + arr(r + 1, j) / 24
                     ElseIf j = 9 Then
                      brr(m - 2, j) = arr(r, j)
                      brr(m - 1, j) = arr(r + 1, j)
                      brr(m, j) = arr(r, j) + arr(r + 1, j)
                    Else
                      brr(m - 2, j) = arr(r, j)
                      brr(m - 1, j) = arr(r + 1, j)
                      brr(m, j) = arr(r, j) & "/" & arr(r + 1, j)
                    End If
                Next
                brr(m, UBound(arr, 2)) = arr(r, UBound(arr, 2)) + arr(r + 1, UBound(arr, 2))
                i = i + 1
            Else
                m = m + 1
                For j = 1 To UBound(arr, 2)
                    brr(m, j) = arr(i, j)
                Next
            End If
        Next
    End With
    With Sheets("结果")
        .[a2:k10000].Clear
        .[a1].Resize(1, UBound(arr, 2)).Interior.Color = 49407
        With .[a2].Resize(m, UBound(arr, 2))
            .Value = brr
            .Borders.LineStyle = 1
            .HorizontalAlignment = xlCenter  '//列居中
            .VerticalAlignment = xlCenter
        End With
    End With
    Application.ScreenUpdating = True
    MsgBox "OK！"
End Sub