分享

30个有用的Excel VBA代码

 东西二王 2023-10-29 发布于重庆

原创2019-03-29 11:58·浮云Excel

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为单元格赋予蓝色。如果你想的话,你可以把这个换成其他颜色。

21.突出显示所选数据集中的空白单元格

虽然可以使用条件格式或“转到特殊”对话框突出显示空白单元格,但如果必须经常这样做,最好使用宏。

创建后,你可以将代码保存在个人宏工作簿中。Sub HighlightBlankCells()  Dim Dataset As Range  Set Dataset = Selection Dataset.SpecialCells(xlCellTypeBlanks).Interior.Color = vbRed  End Sub

在这个代码中,指定了红色单元格中要突出显示的空白单元格。

22.按单列对数据排序

可以使用下面的代码按指定列对数据排序。Sub SortDataHeader()  Range("DataRange").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes  End Sub

请注意,我创建了一个名为“datarange”的命名范围,并使用它来代替单元格引用。

这里还使用了三个关键参数:参照之前的文章

23.按多列对数据排序

下面是将根据多个列对数据排序的代码(A列先排序,在进行B列排序)。Sub SortMultipleColumns()  With ActiveSheet.Sort   .SortFields.Add Key:=Range("A1"), Order:=xlAscending   .SortFields.Add Key:=Range("B1"), Order:=xlAscending   .SetRange Range("A1:C13")   .Header = xlYes .Apply End With  End Sub

注意,这个代码指定了首先根据A列排序,然后根据B列排序

24.如何只从字符串中获取数字部分

如果只从字符串中提取数字部分或文本部分,则可以在VBA中创建自定义函数.

然后,您可以在工作表中使用这个vba函数(就像普通的Excel函数一样),它将只从字符串中提取数字或文本部分.

下面是将创建函数从字符串中提取数字部分的VBA代码:Function GetNumeric(CellRef As String)  Dim StringLength As Integer  StringLength = Len(CellRef)   For i = 1 To StringLength   If IsNumeric(Mid(CellRef, i, 1)) Then  Result = Result & Mid(CellRef, i, 1)   End If  Next i  GetNumeric = Result  End Function

您需要将代码放入模块中,然后可以在工作表中使用函数"=GetNumeric".

此函数只接受一个参数,即要从中获取数值部分的单元格的单元格引用。

25.总是在激活特定选项卡的情况下打开工作簿

如果要打开一个工作簿,该工作簿总是在特定工作表的情况下打开,则可以使用以下代码。

当您希望在工作簿打开时激活指定工作表时,这将非常有用。Private Sub Workbook_Open()  Sheets(“Sheet1”).Select  End Sub

请注意,此代码需要放在ThisWorkbook对象的“代码”窗口中

这意味着当您在VB编辑器中时,需要双击此工作簿对象并复制粘贴其中的代码。

26.一次保存并关闭所有工作簿

如果有许多工作簿打开,并且要保存和关闭这些工作簿,则需要手动转到并保存每个工作簿,然后关闭它。

这是一个VBA代码,它将关闭所有工作簿并在关闭时保存它。Sub CloseAllWorkbooks()  Dim wb As Workbook   For Each wb In Workbooks   wb.Close SaveChanges:=True   Next wb  End Sub

请注意,代码只适用于那些先前已经保存过的工作簿。如果有新工作簿,则必须指定要保存该工作簿的文件夹的名称和位置。

27.限制光标在特定区域的移动

如果要限制工作表中的滚动区域,可以使用以下代码执行此操作:Private Sub Worksheet_Open()  Sheets(“Sheet1”).ScrollArea = “A1:M17”  End Sub

请注意,您需要将此代码放入要限制滚动的工作表中。

28.将筛选后的数据复制到新工作簿中

如果您使用的是一个巨大的数据区域,那么过滤器在分割数据时非常有用。

有时,您可能只需要数据区域的一部分。

在这种情况下,您可以使用下面的代码将筛选后的数据快速复制到新工作表中。Sub CopyFilteredData()   If ActiveSheet.AutoFilterMode = False Then   Exit Sub   End If  ActiveSheet.AutoFilter.Range.Copy  Workbooks.Add.Worksheets(1).Paste  Cells.EntireColumn.AutoFit  End Sub

此代码首先检查是否有任何已筛选的数据

否则,它会复制筛选后的数据,插入新工作簿,并将数据粘贴到其中。

29.将所有公式转换为选定数据集中的值

如果要快速将所有具有公式的单元格转换为值,可以使用以下代码:Sub ConvertFormulastoValues()  Dim MyRange As Range Dim MyCell As Range  Set MyRange = Selection   For Each MyCell In MyRange   If MyCell.HasFormula Then   MyCell.Formula = MyCell.Value   End If   Next MyCell  End Sub

注意这个变化是不可逆的,公式将无法恢复。

或者,你也可以编写一个消息框,显示公式将丢失的警告。这可以防止用户意外运行此宏

30.在单个单元格中获取多个查找值

如果要查找表中的值并在同一单元格中获取所有匹配结果,则需要使用VBA创建自定义函数。

下面是创建了一个公式,类似VLOOKUP。Function GetMultipleLookupValues(Lookupvalue As String, LookupRange As Range, ColumnNumber As Integer)  Dim i As Long  Dim Result As String   For i = 1 To LookupRange.Columns(1).Cells.Count   If LookupRange.Cells(i, 1) = Lookupvalue Then   Result = Result & " " & LookupRange.Cells(i, ColumnNumber) & ","   End If  Next i GetMultipleLookupValues = Left(Result, Len(Result) – 1) End Function

注意,这个函数有三个参数:

LookupValue –需要查询的值

LookupRange – 需要查询的区域

ColumnNumber – 提取结果的列号

    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多