欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页

excel之常用vba代码

程序员文章站 2022-05-15 22:53:45
...
合并当前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