VBA格式化工作簿示例

fanjy

发布于 2024-06-21 08:40:09

17300

代码可运行

文章被收录于专栏：完美Excel完美Excel

运行总次数：0

代码可运行

标签：VBA

如下图1所示的数据工作表Sheet1，列C中有一系列不同的重复值。

图1

下图2是标题行，位于工作表Sheet2中。

图2

现在，想将工作表Sheet1格式化如下图3所示，即以列C中相同的数据为一块，添加标题和名称行。

图3

可以使用VBA代码来快速格式化。在VBE中插入一个标准模块，输入下面的代码：

Sub Reformat()
 Dim aryColD() As String
 Dim cntColD As Long
 Dim i As Long
 Dim rowLast As Long
 Dim rowLastInBlock As Long
 
 Application.ScreenUpdating = False
 
 With Worksheets("Sheet1")
   .ResetAllPageBreaks
 
   rowLast = .Cells(.Rows.Count, 1).End(xlUp).Row
 
   cntColD = 1
   ReDim Preserve aryColD(1 To cntColD)
   aryColD(cntColD) = 1
 
   For i = 2 To rowLast - 1
     If .Cells(i, 3).Value <> .Cells(i + 1, 3).Value Then
       cntColD = cntColD + 1
       ReDim Preserve aryColD(1 To cntColD)
       aryColD(cntColD) = i + 1
     End If
   Next i
   For i = UBound(aryColD) To LBound(aryColD) Step -1
     Application.StatusBar = "处理行" & i 
     Worksheets("Sheet2").Rows(1).Copy
     .Rows(aryColD(i)).Insert Shift:=xlDown
 
     .Rows(aryColD(i)).Insert Shift:=xlDown
     .Cells(aryColD(i), 1).Value = .Cells(aryColD(i) + 2, 3).Value
     .Cells(aryColD(i), 1).Font.Bold = True
 
     rowLastInBlock = .Cells(aryColD(i), 1).End(xlDown).Row
 
     With .Cells(aryColD(i) + 1, 1).Resize(rowLastInBlock - aryColD(i), 4).Borders
       .LineStyle = xlContinuous
       .ColorIndex = 0
       .TintAndShade = 0
       .Weight = xlThin
     End With
 
     If aryColD(i) > 1 Then .HPageBreaks.Add Before:=.Rows(aryColD(i))
   Next i
 End With
 Application.StatusBar = False
 Application.ScreenUpdating = True
 
 MsgBox "完成"
End Sub