excel之常用vba代码

本文链接：https://blog.csdn.net/PpikachuP/article/details/93410733

合并当前sheet表之前的所有sheet表，并保存到当前sheet表（并在结尾添加一行“abc”，并指定字体和大小）
Sub 合并sheet()
Application.ScreenUpdating = False
For j = 1 To Sheets.Count
   If Sheets(j).Name <> ActiveSheet.Name Then
       x = Range("A65536").End(xlUp).Row + 1
       Sheets(j).UsedRange.Copy Cells(x, 1)
   End If
Next
Range("B1").Select
Application.ScreenUpdating = True
 Dim i As Integer
    i = Range("a65536").End(xlUp).Row
    Cells(i + 2, 1) = "abc"
    Cells(i + 2, 1).Font.Name = "微软雅黑"
    Cells(i + 2, 1).font.Size = 6
End Sub

删除所有隐藏的行和sheet表
Sub 删除隐藏()
Dim i As Integer
Application.DisplayAlerts = False
For i = Sheets.Count To 1 Step -1
If Sheets(i).Visible = False Then
Sheets(i).Delete
Else
End If
Next i
ActiveWorkbook.Save
End Sub

删除除了名为‘Sheet1’表之外的所有sheet
Public Sub 删除所有sheet()
Application.DisplayAlerts = False
    Dim i As Integer
    For i = Sheets.Count To 1 Step -1
        Debug.Print Sheets(i).Name
        If Sheets(i).Name <> "Sheet1" Then
            Sheets(i).Delete
        End If
    Next
Application.DisplayAlerts = True
End Sub

合并指定列所有的相邻单元格内容相同的单元格
Sub 手动合并单元格()
Dim l%, i%
Application.DisplayAlerts = False
k% = InputBox("请输入合并单元格所在列")
l = [A65536].End(xlUp).Row
For i = l To 2 Step -1
     If Cells(i, k) = Cells(i - 1, k) Then
     Range(Cells(i - 1, k), Cells(i, k)).Merge
     End If
Next
Application.DisplayAlerts = True
End Sub
###
自动合并第1,2列所有的相邻单元格内容相同的单元格
 Sub 自动合并所有单元格()
 Dim l%, i%
 Application.DisplayAlerts = False
 For k = 1 To 2
 l = [A65536].End(xlUp).Row
 For i = l To 2 Step -1
     If Cells(i, k) = Cells(i - 1, k) And IsEmpty(Cells(i, k)) = False And IsEmpty(Cells(i - 1, k)) = False Then
     Range(Cells(i - 1, k), Cells(i, k)).Merge
     End If
 Next
 Next
 Application.DisplayAlerts = True
 End Sub

按顺序执行设置的vba模块
Sub 顺序()
    Call 删除隐藏
    Call 合并sheet
    Call 删除所有sheet
End Sub