【转载】EXCEL VBA 20个有用的ExcelVBA代码
1.显示多个隐藏的工作表
如果你的工作簿里面有多个隐藏的工作表,你需要花很多时间一个一个的显示隐藏的工作表。
下面的代码,可以让你一次显示所有的工作表
Sub UnhideAllWoksheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next ws
End Sub
2.隐藏除了活动工作表外的所有工作表
如果你做的报表,希望隐藏除了报表工作表以外的所有工作表,则可以用一下代码来实现:
Sub HideAllExcetActiveSheet()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> ActiveSheet.Name Then
ws.Visible = xlSheetHidden
End if
Next ws
End Sub
3.用VBA代码按字母的顺序对工作表进行排序
如果你有一个包含多个工作表的工作簿,并且希望按字母对工作表进行排序,那么下面的代码,可以派上用场。
Sub SortSheetsTabName()
Application.ScreenUpdating = False
Dim ShCount As Integer, i As Integer, j As Integer
ShCount = Sheets.Count
For i = 1 To ShCount - 1
For j = i + 1 To ShCount
If Sheets(j).Name < Sheets(i).Name Then
Sheets(j).Move before:=Sheets(i)
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
4.一次性保护所有的工作表
如果工作薄里面有多个工作表,并且希望保护所有的工作表,那么下面的代码,可以派上用场。
Sub ProtectAllSheets()
Dim ws As Worksheet
Dim password As String
'用你想要的密码替换Test123
password = "Test123"
For Each ws In Worksheets
ws.Protect password:=password
Next ws
End Sub
5.一次性取消所有的工作表保护
如果你保护了你所有的工作表,那么你只需要修改一下代码,就可以取消所有工作表的保护。
Sub ProtectAllSheets()
Dim ws As Worksheet
Dim password As String
'用你想要的密码替换Test123
password = "Test123"
For Each ws In Worksheets
ws.Unprotect password:=password
Next ws
End Sub
需要注意的是,取消保护工作表的密码, 要与锁定工作表的密码相同,否则程序会抛出异常(出错)。
6.显示所有隐藏的行和列
下面的代码,可以取消所有隐藏的行和列。
如果你从别人那里获得一个Excel文件,并希望没有隐藏的行与列,那么下面的代码对你非常有用。
Sub UnhideRowsColumns()
Columns.EntireColumn.Hidden = False
Rows.EntireRow.Hidden = False
End Sub
7.取消所有的合并单元格
把多个单元格合并成一个单元格时常用的做法:
如果你的工作表里面有合并的单元格,使用下面代码可以一次性取消所有合并的单元格。
Sub UnmergeAllCells()
ActiveSheet.Cells.UnMerge
End Sub
8.保存带有时间戳的工作簿
很多时候,您可能需要创建工作的各个版本。
一个好的做法,就是在工作薄名称上,加上时间戳。
使用时间戳将允许您返回到某个文件,查看进行了哪些更改或使用了哪些数据。
下面的代码会自动保存工作簿在指定的文件夹中,并添加一个时间戳时保存。
Sub SaveWorkbookWithTimeStamp()
Dim timestamp As String
timestamp = Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hh-ss") ThisWorkbook.SaveAs "C:UsersUsernameDesktopWorkbookName" & timestamp
End Sub
C:UsersUsernameDesktopWorkbookName 你可以制定文件位置和文件名。
"dd-mm-yyyy"指的的日期的格式。
"hh-ss"指的是时间的格式
9.将工作表另存为一个PDF文件
如果您使用不同年份或部门或产品的数据,可能需要将不同的工作表保存为PDF文件。
如果手动完成,这可能是一个耗时的过程,但vba确可以加快速度。
下面是一个将每个工作表保存为单独PDF的VBA代码
Sub SaveWorkshetAsPDF()
Dim ws As Worksheet
For Each ws In Worksheets
ws.ExportAsFixedFormat xlTypePDF, "C:UsersSumitDesktopTest" & ws.Name & ".pdf"
Next ws
End Sub
在上面的代码中,我指定了要保存pdf的文件夹位置的地址。
请注意,此代码仅适用于工作表。
10.将工作簿另存为单独的PDF文件
下面是将整个工作簿保存为指定文件夹中的PDF格式的代码
Sub SaveWorkshetAsPDF()
ThisWorkbook.ExportAsFixedFormat xlTypePDF, "C:UsersSumitDesktopTest" & ThisWorkbook.Name & ".pdf"
End Sub
你可以修改储存文件的文件件。
注意:9~10代码保存为PDF文件,需要在工作表里面设置好打印的区域。如果有空的工作表,那么程序会报错。
11.将所有公式转换为值
如果工作表包含大量公式,并且要将这些公式转换为值,请使用此代码。
Sub ConvertToValues()
With ActiveSheet.UsedRange
.Value = .Value
End With
End Sub
此代码可以自动将使用公式的值转换为值
12.有公式的单元格锁定
当您有大量的计算并且不想意外的删除或更改时,您可能希望使用把有公式的单元格进行锁定。
下面是将锁定所有具有公式的单元格的代码,而所有其它单元格都未锁定。
Sub LockCellsWithFormulas()
With ActiveSheet
.Unprotect
.Cells.Locked = False
.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
.Protect AllowDeletingRows:=True
End With
End Sub
13.保护工作簿中所有的工作表
使用以下代码一次性保护工作簿中的所有工作表
Sub ProtectAllSheets()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Protect
Next ws
End Sub
此代码将逐个浏览所有工作表并对其进行保护。
如果要取消所有工作表的保护,可以使用 ws.unProtect
14.在所选内容中每隔一行后插入一行
如果要在选定区域中的每一行后插入空行,请使用此代码。
Sub InsertAlternateRows()
Dim rng As Range
Dim CountRow As Integer
Dim i As Integer
Set rng = Selection
CountRow = rng.EntireRow.Count
For i = 1 To CountRow
ActiveCell.EntireRow.Insert
ActiveCell.Offset(2, 0).Select
Next i
End Sub
同样,您可以修改此代码,以便在所选范围内的每一列之后插入一个空白列
15.自动在相邻单元格中插入日期和时间戳
当您想要跟踪活动时,可以使用时间戳。
使用此代码在创建条目或编辑现有内容时在相邻单元格中插入日期和时间戳。
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Handler
If Target.Column = 1 And Target.Value <> "" Then
Application.EnableEvents = False
Target.Offset(0, 1) = Format(Now(), "dd-mm-yyyy hh:mm:ss") Application.EnableEvents = True
End If
Handler:
End Sub
请注意,您需要将此代码插入工作表代码窗口(而不是模块内代码窗口)。因为这是一个事件代码
16.突出显示所选内容中的可选行
突出显示可选行可以极大地提高数据的可读性。
下面是一个代码,它将立即突出显示所选内容中的可选行。
Sub HighlightAlternateRows()
Dim Myrange As Range
Dim Myrow As Range
Set Myrange = Selection
For Each Myrow In Myrange.Rows
If Myrow.Row Mod 2 = 1 Then
Myrow.Interior.Color = vbCyan
End If
Next Myrow
End Sub
注意,代码中指定了颜色为vbCyan(也可以修改成:vbRed, vbGreen, vbBlue)。
17.突出显示拼错单词的单元格
Excel没有像在Word或PowerPoint中那样进行拼写检查。虽然可以按F7键进行拼写检查,但当出现拼写错误时,没有视觉提示。
使用此代码可以立即突出显示其中有拼写错误的所有单元格。
Sub HighlightMisspelledCells()
Dim cl As Range
For Each cl In ActiveSheet.UsedRange
If Not Application.CheckSpelling(word:=cl.Text) Then
cl.Interior.Color = vbRed
End If
Next cl
End Sub
请注意,突出显示的单元格包含Excel认为是拼写错误的文本。当然在许多情况下,它也会其它各种错误。
18.刷新工作簿中的所有透视表
如果工作簿中有多个透视表,则可以使用此代码一次刷新所有这些透视表。
Sub RefreshAllPivotTables()
Dim PT As PivotTable
For Each PT In ActiveSheet.PivotTables
PT.RefreshTable
Next PT
End Sub
19.将所选单元格的字母大小写改为大写
虽然Excel有更改文本字母大小写的公式,但它使您可以在另一组单元格中进行更改。
使用此代码可以立即更改所选文本中文本的字母大小写。
Sub ChangeCase()
Dim Rng As Range
For Each Rng In Selection.Cells
If Rng.HasFormula = False Then
Rng.Value = UCase(Rng.Value)
End If
Next Rng
End Sub
注意,在本例中,使用了UCase将文本大小写设为大写。
20.突出显示有批注的单元格
使用下面的代码突出显示其中包含注释的所有单元格。
Sub HighlightCellsWithComments() ActiveSheet.Cells.SpecialCells(xlCellTypeComments).Interior.Color = vbBlue End Sub
在本例中,使用vblue为单元格赋予蓝色。如果你想的话,你可以把这个换成其他颜色。