如何把标题行插入到各部门顶端

wrz

如附件，由于部门很多，怎么样才能把标题行快速插入到各部门的顶部？

zez

Public Sub 过程1()
    N = 65536
    Do
        I = Range("A" & N).End(xlUp).Row
        If Range("A" & I - 1) <> "" Then I = Range("A" & I).End(xlUp).Row
        If I <= 2 Then Exit Do
        Rows(I & ":" & I + 1).Insert Shift:=xlDown
        Range("A2:D2").Copy Range("A" & I + 1)
        N = I
        If N <= 2 Then Exit Do
    Loop
End Sub

ccwan

1. Sub cc()
   
2.     Dim r%
   
3.     With Sheet1
   
4.         r = .[A65536].End(3).Row
   
5.         .Range("A2:A" & r).SpecialCells(xlCellTypeBlanks) = "#"
   
6.         .Range("B2:B" & r).SpecialCells(xlCellTypeBlanks).Offset(1, 0).EntireRow.Insert
   
7.         .Range("A2:D2").Copy .Range("A1:A" & r).SpecialCells(xlCellTypeBlanks)
   
8.         .Range("B2:B" & r).SpecialCells(xlCellTypeBlanks).Offset(1, 0).EntireRow.Insert
   
9.         [A:A].Replace "#", ""
   
10.     End With
    
11. End Sub
    

复制代码

蓝桥玄霜

1. Sub lqxs()
   
2. Dim Arr, i&, r%, Arr1(), ks, bt
   
3. bt = Array("部门", "姓名", "号码", "金额")
   
4. Sheet1.Activate
   
5. Myr = [a65536].End(xlUp).Row
   
6. Arr = Range("a1:d" & Myr)
   
7. For i = 3 To UBound(Arr)
   
8.     If Arr(i, 1) = "" Then
   
9.         r = r + 1
   
10.         ReDim Preserve Arr1(1 To r)
    
11.         Arr1(r) = i
    
12.     End If
    
13. Next
    
14. For i = r To 1 Step -1
    
15.     ks = Arr1(i) + 1
    
16.     Rows(ks).Resize(2).Insert
    
17.     Cells(ks + 1, 1).Resize(1, 4) = bt
    
18. Next
    
19. End Sub
    

复制代码

蓝桥玄霜

请见附件。

wrz

谢谢各位！

wrz

zez 发表于 2013-1-31 14:07
Public Sub 过程1()
    N = 65536
    Do

非常感谢你的帮忙！但后来才发现我发的原表不是实际情况的。实际情况如新附件，请你再花些时间帮忙做下，按部门汇总并插入标题行。表中列数和行数不是固定的。麻烦你在代码后面写下注释。

zez

Public Sub 过程1()
    For n = Range("A65536").End(xlUp).Row To 3 Step -1
        If Cells(n, 1) <> Cells(n + 1, 1) Then
            If i <> 0 Then Cells(i, 11) = Hj
            Hj = 0
            i = n + 1
            If Range("A" & i) <> "" Then
                Rows(i & ":" & i + 3).Insert Shift:=xlDown
                Range("A1:K2").Copy Range("A" & i + 2)
            End If
            Cells(i, 1) = Cells(n, 1)
            Cells(i, 2) = "合计"
            
        End If
        Hj = Hj + Cells(n, 11)
        
    Next
    Cells(i, 11) = Hj
End Sub

wrz

zez 发表于 2013-2-1 13:14
Public Sub 过程1()
    For n = Range("A65536").End(xlUp).Row To 3 Step -1
        If Cells(n, 1)   ...

这么神速！太感谢了！

lrh788

如果给同簿中其他分表插入标题行的代码怎么写呢？