万涛长期深耕政企办公领域，软件应用实战经验丰富，曾为各级党政机关单位和百余家知名企业提供知识服务。严谨专业、幽默风趣、广受好评。热门课程：一份高大上的汇报该怎么做？罗丽虹深入了解WPS全线产品特性，把握技巧应用规律，办公教学实战经验丰富。讲课认真负责，活泼生动，深受学员喜爱。热门课程：职场办公全能力速成课袁远尧10余年专职Office讲师经历，曾为众多企事业单位提供各类培训解决方案，授课风格轻松、生动、贴近工作，并帮助学员将培训成果在政企落地生效。热门课程：快速提升数据处理与分析能力伍昊专注数据化培训十年，国内首先提出"天下第一表"和"三表概念" ，将表格教学提升至企业数据化管理层面的开拓者。热门课程：基于WPS实操的数据管理能力...}

用VBA保存工作表，工作簿的方法：Private Sub CommandButton1_Click()'按钮事件ThisWorkbook.Save
'Save相当于你手工单击 保存按钮End Sub▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲用VBA设置单元格列宽方法Private Sub CommandButton1_Click()'按钮事件Columns("B:H").ColumnWidth=20Columns("H:L").ColumnWidth=10Columns("A:A").ColumnWidth=30End Sub▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲用VBA查看当前打印机代码Private Sub CommandButton1_Click()'按钮事件
MsgBox Application.ActivePrinterEnd Sub▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲用VBA取消所有工作表筛选代码：Private Sub CommandButton1_Click()
'按钮事件Dim sht As WorksheetFor Each sht In ActiveWorkbook.WorksheetsIf sht.AutoFilterMode = True Then sht.AutoFilterMode = False
'取消所有工作表筛选NextEnd Sub▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲VBA中单元格位移方法，解释：submy_offset(0,1).Select'当前单元格向左移动一格(0,-1).Select'当前单元格向右移动一格(1,0).Select'当前单元格向下移动一格(-1,0).Select'当前单元格向上移动一格endsub▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲单元格使用公式后显示0的去除方法，把单元格格式设置为自定义输入类型 0;-0;;@ 即可▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲有时候我们在录入数据的时候需要清空指定单元格内容，一个一个清空内容又太麻烦，这个时候我们可以制作一个按钮一键清空指定单元格内容，代码如下Private Sub CommandButton1_Click()
'按钮事件Range("a1:b5,d1:e9").ClearContentsEnd Sub'清除a1:b5
，
d1:e9 单元格内容，需要清空的单元格根据需要自己设置。▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲'多条件筛选实现代码Private Sub CommandButton1_Click()
'按钮事件Sheet1.Range("A1:F30").AutoFilter Field:=2, Criteria1:=Array("1","2","3","4", "5"), Operator:=xlFilterValuesEnd Sub'代码解释：12345是我们需要筛选的内容，A1:F30是筛选的区域，Field:=2 筛选第二列，根据需要自己设置一下。▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲当我们把工作表设置了密码保护时，有很多功能用不了，比如没有办法使用筛选功能，没有办法把文本框的内容写入表格，解决方法如下With Sheets("sheet2").Unprotect Password:="123456"
'解除工作表保护'此处是你需要运行的功能.Protect Password:="123456"
'保护工作表，设置密码End With解释：sheet2是第二个工作表，根据需要自行设置，123456，是你工作表设置的密码，在你需要运行代码的头尾处插入以上代码即可，代码功能解释：先解开工作表密码，然后运行你所需要的功能，然后工作表在加密码保护。▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲当我们制作表格时有时候需要一键快速打印，这个时候我们就要制作一个打印按钮打印一次递增的数量Private Sub CommandButton1_Click() '按钮命令[A1] = [A1] + 1
'A1单元格打印一次加1Worksheets("sheet2").PrintOut From:=1, To:=1, Copies:=1
'打印命令End Sub'按钮命令，点击打印 From:=1起始页 To:=1结束页 Copies:=1打印份数,sheet2就是指定打印第二个工作表，根据需要，随便指定打印哪个工作表，哪一页。[A1] = [A1] + 1
'A1单元格打印一次加1，根据需要添加，在这里的作用是打印一次A1单元格内容加1，用于自动编号，比如打印一次编号递增，XS0000056 。▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲ThisWorkbook 代码 工作簿启动时运行窗体（必填）Private Sub Workbook_Open()UserForm1.Show vbModeless '显示窗口的同时可以操作窗口以为的事物End SubPrivate Sub Workbook_Open()UserForm1.Show
'显示窗口时不可以操作窗口以为的事物End Sub当我们制作VBA窗体时需要在打开工作簿时就运行我们的窗体，我们就要在ThisWorkbook里面写入启动窗口代码UserForm1.Show 就是启动第1个窗口，需要启动时启动哪个窗口就设置哪个，根据需要随便设置。▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲隐藏数据列的vba代码。Private Sub CommandButton1_Click()Worksheets("sheet2").Columns("C").Hidden = True'隐藏第C列，sheet2就是隐藏sheet2工作表的C列End SubPrivate Sub CommandButton2_Click()Worksheets("sheet2").Columns("C").Hidden = False'取消隐藏第C列End Sub指定工作表和哪一列根据自己需要设置。▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲VBA隐藏和取消隐藏工作表假设要隐藏第2个工作表Private Sub CommandButton1_Click()
Sheets(2).Visible = FalseEnd Sub取消隐藏就把false改为true▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲excel表格如何为工作表指定区域设置使用有效期限1、选定A1到E15单元格，设置单元格格式，保护里面解除锁定，2、在数据里面设置数据有效性，选择自定义，填入公式=TODAY()<DATE(2023,1,5)3、出错警告里面填写你想提示的内容，确定，4、保护工作表，设置密码，当系统时间大于2023,1,5 A1到E15单元格不可输入或编辑，自动锁定单元格，公式里面时间可以随便设置，根据需要设置。}

非常实用的Excel VBA 100个经典函数源码大全-常用功能(全网首发-必收藏)花了整整5个小时的功夫，终于完成了这100个经典函数代码的整理，翻译及排版(知乎的格式总是容易变形及崩溃，我内心也是崩溃的）原作者：ExcelChamps原英文网址：原文翻译及整理： @小辣椒高效Office 别只顾收藏吃灰，也请点个赞及关注我们 @小辣椒高效Office ，更重要的是要学会并用在自己的工作中。1. 添加序列号Sub AddSerialNumbers()
Dim i As Integer
On Error GoTo Last
i = InputBox("Enter Value", "Enter Serial Numbers")
For i = 1 To i
ActiveCell.Value = i
ActiveCell.Offset(1, 0).Activate
Next i
Last:Exit Sub
End Sub
此宏代码将帮助您在Excel工作表中自动添加序列号，如果您使用大数据，这对您有所帮助。要使用此代码，您需要选择要从中开始序列号的单元格，当您运行此代码时，它会显示一个消息框，您需要在其中输入序列号的最高数字，然后单击“确定”。单击“确定”后，它只需运行一个循环，然后向下向单元格添加序列号列表。 2. 插入多列Sub InsertMultipleColumns()
Dim i As Integer
Dim j As Integer
ActiveCell.EntireColumn.Select
On Error GoTo Last
i = InputBox("Enter number of columns to insert", "Insert Columns")
For j = 1 To i
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromRightorAbove
Next j
Last: Exit Sub
End Sub 'Translate By Tmtony
此代码可帮助您一次单击输入多个列。运行此代码时，它会询问您要添加的列数，当您单击“确定”时，它会在所选单元格后添加输入的列数。如果要在所选单元格之前添加列，请将代码中的 xlToRight 替换为 xlToLeft。 3. 插入多行Sub InsertMultipleRows()
Dim i As Integer
Dim j As Integer
ActiveCell.EntireRow.Select
On Error GoTo Last
i = InputBox("Enter number of columns to insert", "Insert Columns")
For j = 1 To i
Selection.Insert Shift:=xlToDown, CopyOrigin:=xlFormatFromRightorAbove
Next j
Last: Exit Sub
End Sub
使用此代码，您可以在工作表中输入多行。运行此代码时，可以输入要插入的行数，并确保从中选择要插入新行的单元格。如果要在所选单元格之前添加行，请将代码中的 xlToDown 替换为 xlToUp。 4. 自动调整列Sub AutoFitColumns()
Cells.Select
Cells.EntireColumn.AutoFit
End Sub
此代码可快速自动填充工作表中的所有列。因此，当您运行此代码时，它将选择工作表中的所有单元格并立即自动填充所有列。 5. 自动调整行Sub AutoFitRows()
Cells.Select
Cells.EntireRow.AutoFit
End Sub
您可以使用此代码自动调整工作表中的所有行。当您运行此代码时，它将选择工作表中的所有单元格，并立即自动调整所有行。 6. 删除文字绕排Sub RemoveTextWrap()
Range("A1").WrapText = False
End Sub
此代码将帮助您只需单击一下即可从整个工作表中删除文本换行。它将首先选择所有列，然后删除文本换行并自动适应所有行和列。还有一个快捷方式可以使用（Alt H W），但是如果您将此代码添加到QAT，则它不仅仅是键盘快捷方式。 7. 取消合并单元格Sub UnmergeCells()
Selection.UnMerge
End Sub 'Translate By Tmtony
此代码仅使用“主页”选项卡上的取消合并选项。使用此代码的好处是可以将其添加到 QAT 并取消合并所选内容中的所有单元格。如果要取消合并特定范围，可以通过替换单词选择在代码中定义该范围。 8. 打开计算器Sub OpenCalculator()
Application.ActivateMicrosoftApp Index:=0
End Sub
在Windows中，有一个特定的计算器，通过使用此宏代码，您可以直接从Excel打开该计算器。正如我所提到的，它适用于Windows，如果您在MAC版本的VBA中运行此代码，您将收到错误。 9. 添加页眉/页脚日期Sub DateInHeader()
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&D"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With
End Sub
此宏在运行标头时向其添加日期。它只是使用标签” 10. 自定义页眉/页脚Sub CustomHeader()
Dim myText As String
myText = InputBox("Enter your text here", "Enter Text")
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = myText
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With
End Sub
运行此代码时，它会显示一个输入框，要求您输入要添加为标题的文本，输入后单击“确定”。如果您仔细看到这一点，则有六行不同的代码来选择页眉或页脚的位置。假设您要添加左页脚而不是中心页眉，只需将“myText”替换为代码行，方法是从那里替换“”。如果您发现这些代码有用，您可以支持我们创建更多这样的教程。格式化代码 这些VBA代码将帮助您使用一些特定的条件和条件来格式化单元格和范围。 11. 从选择中突出显示重复项Sub HighlightDuplicateValues()
Dim myRange As Range
Dim myCell As Range
Set myRange = Selection
For Each myCell In myRange
If WorksheetFunction.CountIf(myRange, myCell.Value) > 1 Then
myCell.Interior.ColorIndex = 36
End If
Next myCell
End Sub
此宏将检查您选择的每个单元格并突出显示重复值。您还可以更改代码中的颜色。 12. 突出显示活动行和列Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strRange As String
strRange = Target.Cells.Address & "," & _
Target.Cells.EntireColumn.Address & "," & _
Target.Cells.EntireRow.Address
Range(strRange).Select
End Sub 'Translate By Tmtony
每当我必须分析数据表时，我真的很喜欢使用此宏代码。以下是应用此代码的快速步骤。打开 VBE （ALT F11）。转到“项目资源管理器”（Ctrl R，如果隐藏）。选择您的工作簿 13. 突出显示前 10 个值Sub TopTen()
Selection.FormatConditions.AddTop10
Selection.FormatConditions(Selection.FormatConditions.Count).S
tFirstPriority
With Selection.FormatConditions(1)
.TopBottom = xlTop10Top
.Rank = 10
.Percent = False
End With
With Selection.FormatConditions(1).Font
.Color = -16752384
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
只需选择一个范围并运行此宏，它将以绿色突出显示前10个值。 14. 突出显示命名范围Sub HighlightRanges()
Dim RangeName As Name
Dim HighlightRange As Range
On Error Resume Next
For Each RangeName In ActiveWorkbook.Names
Set HighlightRange = RangeName.RefersToRange
HighlightRange.Interior.ColorIndex = 36
Next RangeName
End Sub
如果您不确定工作表中有多少个命名区域，则可以使用此代码突出显示所有这些命名区域。 15. 突出显示大于值Sub HighlightGreaterThanValues()
Dim i As Integer
i = InputBox("Enter Greater Than Value", "Enter Value")
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, _
Operator:=xlGreater, Formula1:=i
Selection.FormatConditions(Selection.FormatConditions.Count).S
tFirstPriority
With Selection.FormatConditions(1)
.Font.Color = RGB(0, 0, 0)
.Interior.Color = RGB(31, 218, 154)
End With
End Sub
运行此代码后，它将要求您输入要从中突出显示所有较大值的值。 16. 突出显示低于以下值的值Sub HighlightLowerThanValues()
Dim i As Integer
i = InputBox("Enter Lower Than Value", "Enter Value")
Selection.FormatConditions.Delete
Selection.FormatConditions.Add _
Type:=xlCellValue, _
Operator:=xlLower, _
Formula1:=i
Selection.FormatConditions(Selection.FormatConditions.Count).S
tFirstPriority
With Selection.FormatConditions(1)
.Font.Color = RGB(0, 0, 0)
.Interior.Color = RGB(217, 83, 79)
End With
End Sub
运行此代码后，它将要求您输入要从中突出显示所有较低值的值。 17. 突出显示负数Sub highlightNegativeNumbers()
Dim Rng As Range
For Each Rng In Selection
If WorksheetFunction.IsNumber(Rng) Then
If Rng.Value < 0 Then
Rng.Font.Color= -16776961
End If
End If
Next
End Sub 'Translate By Tmtony
选择单元格区域并运行此代码。它将检查范围中的每个单元格，并突出显示您有负数的所有单元格。 18. 突出显示特定文本Sub highlightValue()
Dim myStr As String
Dim myRg As range
Dim myTxt As String
Dim myCell As range
Dim myChar As String
Dim I As Long
Dim J As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
myTxt = ActiveWindow.RangeSelection.AddressLocal
Else
myTxt = ActiveSheet.UsedRange.AddressLocal
End If
LInput: Set myRg = _
Application.InputBox _
("please select the data range:", "Selection Required", myTxt, , , , , 8)
If myRg Is Nothing Then
Exit Sub
If myRg.Areas.Count > 1 Then
MsgBox "not support multiple columns"
GoTo Linput
End If
If myRg.Columns.Count <> 2 Then
MsgBox "the selected range can only contain two columns "
GoTo Linput
End If
For I = 0 To myRg.Rows.Count - 1
myStr = myRg.range("B1").Offset(I, 0).Value
With myRg.range("A1").Offset(I, 0)
.Font.ColorIndex = 1
For J = 1 To Len(.Text)
Mid(.Text, J, Len(myStr)) = myStrThen
.Characters(J, Len(myStr)).Font.ColorIndex = 3
Next
End With
Next I
End Sub
假设您有一个大型数据集，并且想要检查特定值。为此，您可以使用此代码。运行它时，您将获得一个输入框，用于输入要搜索的值。 19. 突出显示带有注释的单元格Sub highlightCommentCells()
Selection.SpecialCells(xlCellTypeComments).Select
Selection.Style= "Note"
End Sub
若要突出显示所有带有注释的单元格，请使用此宏。 20. 在所选内容中突出显示替换行Sub highlightAlternateRows()
Dim rng As Range
For Each rng In Selection.Rows
If rng.Row Mod 2 = 1 Then
rng.Style = "20% -Accent1"
rng.Value = rng ^ (1 / 3)
Else
End If
Next rng
End Sub
通过突出显示备用行，您可以使数据易于读取，为此，您可以使用下面的VBA代码。它将简单地突出显示所选范围内的每一行。 21. 突出显示单词拼写错误的单元格Sub HighlightMisspelledCells()
Dim rng As Range
For Each rng In ActiveSheet.UsedRange
If Not Application.CheckSpelling(word:=rng.Text) Then
rng.Style = "Bad"
End If
Next rng
End Sub
如果您发现很难检查所有单元格的拼写错误，那么此代码适合您。它将检查所选内容中的每个单元格，并突出显示拼写错误的单词的单元格。 突出显示整个工作表中出错的单元格Sub highlightErrors()
Dim rng As Range
Dim i As Integer
For Each rng In ActiveSheet.UsedRange
If WorksheetFunction.IsError(rng) Then
i = i + 1
rng.Style = "bad"
End If
Next rng
MsgBox _
"There are total " & i _
& " error(s) in this worksheet."
End Sub 'Translate By Tmtony
要突出显示并计算您有错误的所有单元格，此代码将为您提供帮助。只需运行此代码，它将返回一条带有数字错误单元格的消息，并突出显示所有单元格。 突出显示工作表中具有特定文本的单元格Sub highlightSpecificValues()
Dim rng As range
Dim i As Integer
Dim c As Variant
c = InputBox("Enter Value To Highlight")
For Each rng In ActiveSheet.UsedRange
If rng = c Then
rng.Style = "Note"
i = i + 1
End If
Next rng
MsgBox "There are total " & i & " " & c & " in this worksheet."
End Sub
此代码将帮助您计算具有特定值的单元格，您将提到这些值，然后突出显示所有这些单元格。 24.突出显示所有空白单元格不可见空间Sub blankWithSpace()
Dim rng As Range
For Each rng In ActiveSheet.UsedRange
If rng.Value = " " Then
rng.Style = "Note"
End If
Next rng
End Sub
有时有一些单元格是空白的，但它们只有一个空格，因此，很难识别它们。此代码将检查工作表中的所有单元格，并突出显示具有单个空格的所有单元格。 25. 突出显示范围内的最大值Sub highlightMaxValue()
Dim rng As Range
For Each rng In Selection
If rng = WorksheetFunction.Max(Selection) Then
rng.Style = "Good"
End If
Next rng
End Sub
它将检查所有选定的单元格，并使用最大值突出显示单元格。 26. 突出显示范围内的最小值Sub Highlight_Min_Value()
Dim rng As Range
For Each rng In Selection
If rng = WorksheetFunction.Min(Selection) Then
rng.Style = "Good"
End If
Next rng
End Sub
它将检查所有选定的单元格，并使用最小值突出显示单元格。 27. 突出显示唯一值Sub highlightUniqueValues()
Dim rng As Range
Set rng = Selection
rng.FormatConditions.Delete
Dim uv As UniqueValues
Set uv = rng.FormatConditions.AddUniqueValues
uv.DupeUnique = xlUnique
uv.Interior.Color = vbGreen
End Sub 'Translate By Tmtony
此代码将突出显示所选内容中具有唯一值的所有单元格。 28. 突出显示列中的差异Sub columnDifference()
Range("H7:H8,I7:I8").Select
Selection.ColumnDifferences(ActiveCell).Select
Selection.Style= "Bad"
End Sub
使用此代码，您可以突出显示两列（相应单元格）之间的差异。 29. 突出显示行中的差异Sub rowDifference()
Range("H7:H8,I7:I8").Select
Selection.RowDifferences(ActiveCell).Select
Selection.Style= "Bad"
End Sub
通过使用此代码，您可以突出显示两行（相应单元格）之间的差异。打印代码 这些宏代码将帮助您自动执行一些打印任务，从而进一步节省大量时间。 30. 打印注释Sub printComments()
With ActiveSheet.PageSetup
.printComments = xlPrintSheetEnd
End With
End Sub
使用此宏可以激活设置以在页面末尾打印单元格注释。假设您有10页要打印，使用此代码后，您将获得第11页最后一页上的所有评论。 31. 打印窄边距Sub printNarrowMargin()
With ActiveSheet.PageSetup
.LeftMargin = Application
.InchesToPoints (0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
End With
ActiveWindow.SelectedSheets.PrintOut _
Copies:=1, _
Collate:=True, _
IgnorePrintAreas:=False
End Sub
使用此VBA代码进行窄边距打印。运行此宏时，它会自动将边距更改为窄。 32. 打印选择Sub printSelection()
Selection.PrintOut Copies:=1, Collate:=True
End Sub 'Translate By Tmtony
此代码将帮助您打印所选范围。您无需转到打印选项并设置打印范围。只需选择一个范围并运行此代码。 33. 打印自定义页面Sub printCustomSelection()
Dim startpage As Integer
Dim endpage As Integer
startpage = _
InputBox("Please Enter Start Page number.", "Enter Value")
If Not WorksheetFunction.IsNumber(startpage) Then
MsgBox _
"Invalid Start Page number. Please try again.", "Error"
Exit Sub
End If
endpage = _
InputBox("Please Enter End Page number.", "Enter Value")
If Not WorksheetFunction.IsNumber(endpage) Then
MsgBox _
"Invalid End Page number. Please try again.", "Error"
Exit Sub
End If
Selection.PrintOut From:=startpage, _
To:=endpage, Copies:=1, Collate:=True
End Sub
您可以使用此代码来打印自定义页面范围，而不是使用打印选项中的设置。假设您要打印从 5 到 10 的页面。您只需要运行此VBA代码并输入起始页和结束页即可。工作表代码 这些宏代码将帮助您以简单的方式控制和管理工作表，并节省大量时间。 34. 隐藏除活动工作表之外的所有工作表Sub HideWorksheet()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> ThisWorkbook.ActiveSheet.Name Then
ws.Visible = xlSheetHidden
End If
Next ws
End Sub
现在，假设您要隐藏工作簿中除活动工作表之外的所有工作表。此宏代码将为您执行此操作。相关：VBA 函数列表 35. 取消隐藏所有隐藏的工作表Sub UnhideAllWorksheet()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next ws
End Sub
如果您想取消隐藏使用以前的代码隐藏的所有工作表，那么这里是该代码。 36. 删除除活动工作表之外的所有工作表Sub DeleteWorksheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.name <> ThisWorkbook.ActiveSheet.name Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
End Sub
如果要删除除活动工作表以外的所有工作表，此宏对您很有用。运行此宏时，它会将活动工作表的名称与其他工作表进行比较，然后将其删除。 37.立即保护所有工作表Sub ProtectAllWorskeets()
Dim ws As Worksheet
Dim ps As String
ps = InputBox("Enter a Password.", vbOKCancel)
For Each ws In ActiveWorkbook.Worksheets
ws.Protect Password:=ps
Next ws
End Sub 'Translate By Tmtony
如果您想一次性保护所有工作表，这里有一个适合您的代码。运行此宏时，您将获得一个用于输入密码的输入框。输入密码后，单击“确定”。并确保注意CAPS。 38. 调整工作表中所有图表的大小Sub Resize_Charts()
Dim i As Integer
For i = 1 To ActiveSheet.ChartObjects.Count
With ActiveSheet.ChartObjects(i)
.Width = 300
.Height = 200
End With
Next i
End Sub
使所有图表的大小相同。此宏代码将帮助您制作相同大小的所有图表。您可以通过在宏代码中更改图表来更改图表的高度和宽度。 39. 插入多个工作表Sub InsertMultipleSheets()
Dim i As Integer
i = _
InputBox("Enter number of sheets to insert.", _
"Enter Multiple Sheets")
Sheets.Add After:=ActiveSheet, Count:=i
End Sub
如果要在单个镜头中在工作簿中添加多个工作表，则可以使用此代码。运行此宏代码时，您将获得一个输入框，用于输入要输入的工作表总数。 40. 保护工作表Sub ProtectWS()
ActiveSheet.Protect "mypassword", True, True
End Sub
如果要保护工作表，可以使用此宏代码。您所要做的就是在代码中提及您的密码。 41. 取消保护工作表Sub UnprotectWS()
ActiveSheet.Unprotect "mypassword"
End Sub
如果要取消对工作表的保护，可以使用此宏代码。您所要做的就是提及您在保护工作表时使用的密码。 42. 对工作表进行排序Sub SortWorksheets()
Dim i As Integer
Dim j As Integer
Dim iAnswer As VbMsgBoxResult
iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _
& "Clicking No will sort in Descending Order", _
vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
For i = 1 To Sheets.Count
For j = 1 To Sheets.Count - 1
If iAnswer = vbYes Then
If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
ElseIf iAnswer = vbNo Then
If UCase$(Sheets(j).Name) < UCase$(Sheets(j + 1).Name) Then Sheets(j).Move After:=Sheets(j + 1)
End If
End If
Next j
Next i
End Sub 'Translate By Tmtony
此代码将帮助您根据工作表的名称对工作簿中的工作表进行排序。 （整理： @小辣椒高效Office ）43.用公式保护所有单元格Sub lockCellsWithFormulas()
With ActiveSheet
.Unprotect
.Cells.Locked = False
.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
.Protect AllowDeletingRows:=True
End With
End Sub
若要通过单击使用公式保护单元格，您可以使用此代码。 44. 删除所有空白工作表Sub deleteBlankWorksheets()
Dim Ws As Worksheet
On Error Resume Next
Application.ScreenUpdating= False
Application.DisplayAlerts= False
For Each Ws In Application.Worksheets
If Application.WorksheetFunction.CountA(Ws.UsedRange) = 0 Then
Ws.Delete
End If
Next
Application.ScreenUpdating= True
Application.DisplayAlerts= True
End Sub
运行此代码，它将检查活动工作簿中的所有工作表，如果工作表为空，则将其删除。 45. 取消隐藏所有行和列Sub UnhideRowsColumns()
Columns.EntireColumn.Hidden = False
Rows.EntireRow.Hidden = False
End Sub
无需手动将行和列隐藏一个，您可以使用此代码一次性执行此操作。 46. 将每个工作表另存为单个 PDFSub SaveWorkshetAsPDF()
Dimws As Worksheet
For Each ws In Worksheets
ws.ExportAsFixedFormat _
xlTypePDF, _
"ENTER-FOLDER-NAME-HERE" & _
ws.Name & ".pdf"
Next ws
End Sub
此代码将简单地将所有工作表保存在单独的PDF文件中。您只需要从代码中更改文件夹名称即可。 47. 禁用分页符Sub DisablePageBreaks()
Dim wb As Workbook
Dim wks As Worksheet
Application.ScreenUpdating = False
For Each wb In Application.Workbooks
For Each Sht In wb.Worksheets
Sht.DisplayPageBreaks = False
Next Sht
Next wb
Application.ScreenUpdating = True
End Sub 'Translate By Tmtony
若要禁用分页符，请使用此代码。它只会从所有打开的工作簿中禁用分页符。工作簿代码 这些代码将帮助您以简单的方式以最少的工作量执行工作簿级任务。 48. 创建当前工作簿的备份Sub FileBackUp()
ThisWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & _
"" & Format(Date, "mm-dd-yy") & " " & _
ThisWorkbook.name
End Sub
这是最有用的宏之一，可以帮助您保存当前工作簿的备份文件。它将备份文件保存在保存当前文件的同一目录中，并且还将添加带有文件名的当前日期。 49. 一次关闭所有工作簿Sub CloseAllWorkbooks()
Dim wbs As Workbook
For Each wbs In Workbooks
wbs.Close SaveChanges:=True
Next wb
End Sub
使用此宏代码关闭所有打开的工作簿。此宏代码将首先逐个检查所有工作簿并关闭它们。如果未保存任何工作表，您将收到一条消息以保存它。 50. 将活动工作表复制到新工作簿中Sub CopyWorksheetToNewWorkbook()
ThisWorkbook.ActiveSheet.Copy _
Before:=Workbooks.Add.Worksheets(1)
End Sub
假设您要在新工作簿中复制活动工作表，只需运行此宏代码，它就会为您做同样的事情。这超级节省时间。 51. 电子邮件中的活动工作簿Sub Send_Mail()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = "Sales@FrontLinePaper.com"
.Subject = "Growth Report"
.Body = "Hello Team, Please find attached Growth Report."
.Attachments.Add ActiveWorkbook.FullName
.display
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
使用此宏代码可以通过电子邮件快速发送活动工作簿。您可以在代码中更改主题，电子邮件和正文文本，如果要直接发送此邮件，请使用“ 。发送“而不是””。显示”。 52. 将工作簿添加到邮件附件Sub OpenWorkbookAsAttachment()
Application.Dialogs(xlDialogSendMail).Show
End Sub 'Translate By Tmtony
运行此宏后，它将打开您的默认邮件客户端，并将其作为附件附加活动工作簿。(整理： @小辣椒高效Office ）53. 欢迎辞Sub auto_open()
MsgBox _
"Welcome To ExcelChamps & Thanks for downloading this file."
End Sub
您可以使用auto_open来执行打开文件的任务，您所要做的就是将宏命名为“auto_open”。 54. 结束语Sub auto_close()
MsgBox "Bye Bye! Don't forget to check other cool stuff on
excelchamps.com"
End Sub
您可以使用close_open来执行打开文件的任务，您所要做的就是将宏命名为“close_open”。 55. 对打开的未保存工作簿进行计数Sub VisibleWorkbooks()
Dim book As Workbook
Dim i As Integer
For Each book In Workbooks
If book.Saved = False Then
i = i + 1
End If
Next book
MsgBox i
End Sub
假设您有5-10个打开的工作簿，您可以使用此代码来获取尚未保存的工作簿的数量。数据透视表代码 这些代码将帮助您在快速管理数据透视表中并进行一些更改。 56. 隐藏数据透视表小计Sub HideSubtotals()
Dim pt As PivotTable
Dim pf As PivotField
On Error Resume Next
Set pt = ActiveSheet.PivotTables(ActiveCell.PivotTable.Name)
If pt Is Nothing Then
MsgBox "You must place your cursor inside of a PivotTable."
Exit Sub
End If
For Each pf In pt.PivotFields
pf.Subtotals(1) = True
pf.Subtotals(1) = False
Next pf
End Sub
如果要隐藏所有小计，只需运行此代码。首先，请确保从数据透视表中选择一个单元格，然后运行此宏。 57. 刷新所有数据透视表Sub vba_referesh_all_pivots()
Dim pt As PivotTable
For Each pt In ActiveWorkbook.PivotTables
pt.RefreshTable
Next pt
End Sub 'Translate By Tmtony
刷新所有数据透视表的超快速方法。只需运行此代码，工作簿中的所有数据透视表都将在一次射击中刷新。 58. 创建数据透视表Follow this step by step guide to create a pivot table using VBA.
59. 自动更新数据透视表范围Sub UpdatePivotTableRange()
Dim Data_Sheet As Worksheet
Dim Pivot_Sheet As Worksheet
Dim StartPoint As Range
Dim DataRange As Range
Dim PivotName As String
Dim NewRange As String
Dim LastCol As Long
Dim lastRow As Long
'
Set Pivot Table & Source Worksheet
Set Data_Sheet = ThisWorkbook.Worksheets("PivotTableData3")
Set Pivot_Sheet = ThisWorkbook.Worksheets("Pivot3")
'
Enter in Pivot Table Name
PivotName = "PivotTable2"
'
Defining Staring Point & Dynamic Range
Data_Sheet.Activate
Set StartPoint = Data_Sheet.Range("A1")
LastCol = StartPoint.End(xlToRight).Column
DownCell = StartPoint.End(xlDown).Row
Set DataRange = Data_Sheet.Range(StartPoint, Cells(DownCell, LastCol))
NewRange = Data_Sheet.Name & "!" & DataRange.Address(ReferenceStyle:=xlR1C1)
'
Change Pivot Table Data Source Range Address
Pivot_Sheet.PivotTables(PivotName). _
ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)
'
Ensure Pivot Table is Refreshed
Pivot_Sheet.PivotTables(PivotName).RefreshTable
'
Complete Message
Pivot_Sheet.Activate
MsgBox "Your Pivot Table is now updated."
End Sub
如果您不使用Excel表格，则可以使用此代码来更新数据透视表范围。 （整理： @小辣椒高效Office ）60. 禁用/启用获取透视数据Sub activateGetPivotData()
Application.GenerateGetPivotData = True
End Sub
End Sub
Sub deactivateGetPivotData（） Application.GenerateGetPivotData = False 要禁用/启用GetPivotData功能，您需要使用Excel选项。但是使用此代码，您只需单击一下即可完成。图表代码 使用这些VBA代码在Excel中管理图表并节省大量时间。 61. 更改图表类型Sub ChangeChartType()
ActiveChart.ChartType = xlColumnClustered
End Sub
此代码将帮助您转换图表类型，而无需使用选项卡中的图表选项。您所要做的就是指定要转换为的类型。下面的代码会将选定的图表转换为簇状柱形图。不同类型的代码不同，您可以从这里找到所有这些类型。 62. 将图表粘贴为图像Sub ConvertChartToPicture()
ActiveChart.ChartArea.Copy
ActiveSheet.Range("A1").Select
ActiveSheet.Pictures.Paste.Select
End Sub 'Translate By Tmtony
此代码将帮助您将图表转换为图像。您只需要选择图表并运行此代码即可。 63. 添加图表标题Sub AddChartTitle()
Dim i As Variant
i = InputBox("Please enter your chart title", "Chart Title")
On Error GoTo Last
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = i
Last:
Exit Sub
End Sub
首先，您需要选择图表并运行此代码。您将获得一个输入框来输入图表标题。高级代码 可用于在电子表格中预制高级任务的一些代码。 64. 将所选范围另存为 PDFSub HideSubtotals()
Dim pt As PivotTable
Dim pf As PivotField
On Error Resume Next
Set pt = ActiveSheet.PivotTables(ActiveCell.PivotTable.name)
If pt Is Nothing Then
MsgBox "You must place your cursor inside of a PivotTable."
Exit Sub
End If
For Each pf In pt.PivotFields
pf.Subtotals(1) = True
pf.Subtotals(1) = False
Next pf
End Sub
如果要隐藏所有小计，只需运行此代码。首先，请确保从数据透视表中选择一个单元格，然后运行此宏。 65. 创建目录Sub TableofContent()
Dim i As Long
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Table of Content").Delete
Application.DisplayAlerts = True
On Error GoTo 0
ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Worksheets(1)
ActiveSheet.Name = "Table of Content"
For i = 1 To Sheets.Count
With ActiveSheet
.Hyperlinks.Add _
Anchor:=ActiveSheet.Cells(i, 1), _
Address:="", _
SubAddress:="'" & Sheets(i).Name & "'!A1", _
ScreenTip:=Sheets(i).Name, _
TextToDisplay:=Sheets(i).Name
End With
Next i
End Sub
假设您的工作簿中有超过 100 个工作表，现在很难导航。不要担心这个宏代码会拯救一切。当您运行此代码时，它将创建一个新工作表，并创建一个带有超链接的工作表索引。 （整理： @小辣椒高效Office ）66.将范围转换为图像Sub PasteAsPicture()
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Pictures.Paste.Select
End Sub
将所选范围粘贴为图像。您只需要选择范围，运行此代码后，它将自动插入该范围的图片。 67. 插入链接的图片Sub LinkedPicture()
Selection.Copy
ActiveSheet.Pictures.Paste(Link:=True).Select
End Sub 'Translate By Tmtony
此VBA代码会将您选择的范围转换为链接的图片，您可以在任何您想要的地方使用该图像。 68. 使用文本到语音转换Sub Speak()
Selection.Speak
End Sub
只需选择一个范围并运行此代码。Excel将逐个单元格地说出您在该范围内的所有文本。 69. 激活数据输入表单Sub DataForm()
ActiveSheet.ShowDataForm
End Sub
有一个默认的数据输入表单，可用于数据输入。 70.使用目标搜索Sub GoalSeekVBA()
Dim Target As Long
On Error GoTo Errorhandler
Target = InputBox("Enter the required value", "Enter Value")
Worksheets("Goal_Seek").Activate
With ActiveSheet.Range("C7")
.GoalSeek_ Goal:=Target, _
ChangingCell:=Range("C2")
End With
Exit Sub
Errorhandler: MsgBox ("Sorry, value is not valid.")
End Sub
目标寻求可以非常有助于您解决复杂的问题。在使用此代码之前，请在此处了解有关目标查找的详细信息。 71.在谷歌上搜索的VBA代码Sub SearchWindow32()
Dim chromePath As String
Dim search_string As String
Dim query As String
query = InputBox("Enter here your search here", "Google Search")
search_string = query
search_string = Replace(search_string, " ", "+")
'
Uncomment the following line for Windows 64 versions and comment out Windows 32 versions'
'
chromePath = "C:Program FilesGoogleChromeApplicationchrome.exe"
'
Uncomment the following line for Windows 32 versions and comment out Windows 64 versions
'
chromePath = "C:Program Files (x86)GoogleChromeApplicationchrome.exe"
Shell (chromePath & " -url http://google.com/#q=" & search_string)
End Sub
请点击这篇文章，了解如何使用此VBA代码在Google上进行搜索。公式代码 这些代码将帮助您计算或获得通常使用工作表函数和公式的结果。 72. 将所有公式转换为值Sub convertToValues()
Dim MyRange As Range
Dim MyCell As Range
Select Case _
MsgBox("You Can't Undo This Action. " _
& "Save Workbook First?", vbYesNoCancel, _
"Alert")
Case Is = vbYes
ThisWorkbook.Save
Case Is = vbCancel
Exit Sub
End Select
Set MyRange = Selection
For Each MyCell In MyRange
If MyCell.HasFormula Then
MyCell.Formula = MyCell.Value
End If
Next MyCell
End Sub 'Translate By Tmtony
只需将公式转换为值即可。运行此宏时，它会快速将公式更改为绝对值。 73.从所选单元格中删除空格Sub RemoveSpaces()
Dim myRange As Range
Dim myCell As Range
Select Case MsgBox("You Can't Undo This Action. " _
& "Save Workbook First?", _
vbYesNoCancel, "Alert")
Case Is = vbYesThisWorkbook.Save
Case Is = vbCancel
Exit Sub
End Select
Set myRange = Selection
For Each myCell In myRange
If Not IsEmpty(myCell) Then
myCell = Trim(myCell)
End If
Next myCell
End Sub
此列表中最有用的宏之一。它将检查您的选择，然后从中删除所有多余的空格。 74. 从字符串中删除字符Public Function removeFirstC(rng As String, cnt As Long)
removeFirstC = Right(rng, Len(rng) - cnt)
End Function
Simply remove characters from the starting of a text string. All you need is to refer to a cell or insert a text into the function and number of characters to remove from the text string.
It has two arguments "rng" for the text string and "cnt" for the count of characters to remove. For Example: If you want to remove first characters from a cell, you need to enter 1 in cnt.
75. 在 Excel 中添加插入度数符号Sub degreeSymbol( )
Dim rng As Range
For Each rng In Selection
rng.Select
If ActiveCell <> "" Then
If IsNumeric(ActiveCell.Value) Then
ActiveCell.Value = ActiveCell.Value & "°"
End If
End If
Next
End Sub
假设您在一列中有一个数字列表，并且您希望添加所有数字的度数符号。 76. 反转文本Public Function rvrse(ByVal cell As Range) As String
rvrse = VBA.strReverse(cell.Value)
End Function
All you have to do just enter "rvrse" function in a cell and refer to the cell in which you have text which you want to reverse.
77. 激活 R1C1 参考样式Sub ActivateR1C1()
If Application.ReferenceStyle = xlA1 Then
Application.ReferenceStyle = xlR1C1
Else
Application.ReferenceStyle = xlR1C1
End If
End Sub 'Translate By Tmtony
此宏代码将帮助您在不使用 Excel 选项的情况下激活 R1C1 引用样式。 78. 激活 A1 参考样式Sub ActivateA1()
If Application.ReferenceStyle = xlR1C1 Then
Application.ReferenceStyle = xlA1
Else
Application.ReferenceStyle = xlA1
End If
End Sub
此宏代码将帮助您在不使用Excel选项的情况下激活A1引用样式。 （整理： @小辣椒高效Office ）79. 插入时间范围Sub TimeStamp()
Dim i As Integer
For i = 1 To 24
ActiveCell.FormulaR1C1 = i & ":00"
ActiveCell.NumberFormat = "[$-409]h:mm AM/PM;@"
ActiveCell.Offset(RowOffset:=1, ColumnOffset:=0).Select
Next i
End Sub
使用此代码，您可以按从 00：00 到 23：00 的顺序插入时间范围。 80. 将日期转换为天Sub date2day()
Dim tempCell As Range
Selection.Value = Selection.Value
For Each tempCell In Selection
If IsDate(tempCell) = True Then
With tempCell
.Value = Day(tempCell)
.NumberFormat = "0"
End With
End If
Next tempCell
End Sub
如果您的工作表中有日期，并且想要将所有这些日期转换为天，那么此代码适合您。只需选择单元格的范围并运行此宏。 81. 将日期转换为年份Sub date2year()
Dim tempCell As Range
Selection.Value = Selection.Value
For Each tempCell In Selection
If IsDate(tempCell) = True Then
With tempCell
.Value = Year(tempCell)
.NumberFormat = "0"
End With
End If
Next tempCell
End Sub
此代码将日期转换为年份。 82.从日期中删除时间Sub removeTime()
Dim Rng As Range
For Each Rng In Selection
If IsDate(Rng) = True Then
Rng.Value = VBA.Int(Rng.Value)
End If
Next
Selection.NumberFormat = "dd-mmm-yy"
End Sub 'Translate By Tmtony
如果您有时间使用日期并希望将其删除，则可以使用此代码。 83.从日期和时间中删除日期Sub removeDate()
Dim Rng As Range
For Each Rng In Selection
If IsDate(Rng) = True Then
Rng.Value = Rng.Value - VBA.Fix(Rng.Value)
End If
NextSelection.NumberFormat = "hh:mm:ss am/pm"
End Sub
它将仅返回日期和时间值的时间。 84. 转换为大写Sub convertUpperCase()
Dim Rng As Range
For Each Rng In Selection
If Application.WorksheetFunction.IsText(Rng) Then
Rng.Value = UCase(Rng)
End If
Next
End Sub
选择单元格并运行此代码。它将检查所选范围的每个单元格，然后将其转换为大写文本。 85. 转换为小写Sub convertLowerCase()
Dim Rng As Range
For Each Rng In Selection
If Application.WorksheetFunction.IsText(Rng) Then
Rng.Value= LCase(Rng)
End If
Next
End Sub
此代码将帮助您将所选文本转换为小写文本。只需选择有文本的单元格范围并运行此代码即可。如果单元格具有数字或文本以外的任何值，则该值将保持不变。 86.转换为正确的大小写Sub convertProperCase()
Dim Rng As Range
For Each Rng In Selection
If WorksheetFunction.IsText(Rng) Then
Rng.Value = WorksheetFunction.Proper(Rng.Value)
End If
Next
End Sub
此代码将所选文本转换为正确的大小写，其中第一个字母大写，其余字母以小写。 87. 转换为句子大小写Sub convertTextCase()
Dim Rng As Range
For Each Rng In Selection
If WorksheetFunction.IsText(Rng) Then
Rng.Value = UCase(Left(Rng, 1)) & LCase(Right(Rng, Len(Rng) - 1))
End If
Next Rng
End Sub 'Translate By Tmtony
在文本大小写中，第一个单词的第一个字母大写，并将所有单词都放在一个句子中，此代码将帮助您将普通文本转换为句子大小写。 88. 从选区中删除字符Sub removeChar()
Dim Rng As Range
Dim rc As String
rc = InputBox("Character(s) to Replace", "Enter Value")
For Each Rng In Selection
Selection.Replace What:=rc, Replacement:=""
Next
End Sub
若要从所选单元格中删除特定字符，可以使用此代码。它将显示一个输入框，用于输入要删除的字符。 89. 整个工作表的字数统计Sub Word_Count_Worksheet()
Dim WordCnt As Long
Dim rng As Range
Dim S As String
Dim N As Long
For Each rng In ActiveSheet.UsedRange.Cells
S = Application.WorksheetFunction.Trim(rng.Text)
N = 0
If S <> vbNullString Then
N = Len(S) - Len(Replace(S, " ", "")) + 1
End If
WordCnt = WordCnt + N
Next rng
MsgBox "There are total " _
& Format(WordCnt, "#,##0") & _
" words in the active worksheet"
End Sub
它可以帮助您计算工作表中的所有单词。 90. 从数字中删除撇号Sub removeApostrophes()
Selection.Value = Selection.Value
End Sub
如果您有数字数据，其中每个数字前都有一个撇号，则运行此代码将其删除。 91.从数字中删除小数Sub removeDecimals()
Dim lnumber As Double
Dim lResult As Long
Dim rng As Range
For Each rng In Selection
rng.Value = Int(rng)
rng.NumberFormat = "0"
Next rng
End Sub
此代码将仅帮助您从所选范围的数字中删除所有小数。 92. 将所有值乘以一个数字Sub addNumber()
Dim rng As Range
Dim i As Integer
i = InputBox("Enter number to multiple", "Input Required")
For Each rng In Selection
If WorksheetFunction.IsNumber(rng) Then
rng.Value = rng + i
Else
End If
Next rng
End Sub 'Translate By Tmtony
让我们有一个数字列表，并且您希望将所有数字与特定数字相乘。若要使用此代码：选择该单元格区域并运行此代码。它将首先询问您要与之相乘的数字，然后立即将其与之相乘。 93.在所有数字中添加一个数字Sub addNumber()
Dim rng As Range
Dim i As Integer
i = InputBox("Enter number to multiple", "Input Required")
For Each rng In Selection
If WorksheetFunction.IsNumber(rng) Then
rng.Value = rng + i
Else
End If
Next rng
End Sub
就像乘法一样，您也可以将一个数字加到一组数字中。 94. 计算平方根Sub getSquareRoot()
Dim rng As Range
Dim i As Integer
For Each rng In Selection
If WorksheetFunction.IsNumber(rng) Then
rng.Value = Sqr(rng)
Else
End If
Next rng
End Sub
若要在不应用公式的情况下计算平方根，可以使用此代码。它只需检查所有选定的单元格并将数字转换为其平方根即可。 95.计算立方根Sub getCubeRoot()
Dim rng As Range
Dimi As Integer
For Each rng In Selection
If WorksheetFunction.IsNumber(rng) Then
rng.Value = rng ^ (1 / 3)
Else
End If
Nextrng
End Sub
若要在不应用公式的情况下计算多维数据集根目录，可以使用此代码。它只需检查所有选定的单元格并将数字转换为其多维数据集根。 96. 在区域中添加 A-Z 字母Sub addsAlphabets1()
Dim i As Integer
For i = 65 To 90
ActiveCell.Value = Chr(i)
ActiveCell.Offset(1, 0).Select
Next i
End Sub
End Sub
子添加阿尔法贝茨2（） Dim i As Integer 对于 i = 97 到 122 ActiveCell.Value = Chr（i） ActiveCell.Offset（1， 0）.选择 下一个 i 就像序列号一样，您也可以在工作表中插入字母。以下是您可以使用的代码。 97.将罗马数字转换为阿拉伯数字Sub convertToNumbers()
Dim rng As Range
Selection.Value = Selection.Value
For Each rng In Selection
If Not WorksheetFunction.IsNonText(rng) Then
rng.Value = WorksheetFunction.Arabic(rng)
End If
Next rng
End Sub 'Translate By Tmtony
有时很难将罗马数字理解为序列号。此代码将帮助您将罗马数字转换为阿拉伯数字。 98.删除负号Sub removeNegativeSign()
Dim rng As Range
Selection.Value = Selection.Value
For Each rng In Selection
If WorksheetFunction.IsNumber(rng) Then
rng.Value = Abs(rng)
End If
Next rng
End Sub
此代码将简单地检查所选内容中的所有单元格，并将所有负数转换为正数。只需选择一个范围并运行此代码。 99. 用零替换空白单元格Sub replaceBlankWithZero()
Dim rng As Range
Selection.Value = Selection.Value
For Each rng In Selection
If rng = "" Or rng = " " Then
rng.Value = "0"
Else
End If
Next rng
End Sub
对于具有空白单元格的数据，可以使用以下代码在所有这些单元格中添加零。这样可以更轻松地在进一步的计算中使用这些单元格。 本人专注VBA及Access Python, 有需要可咨询我：更多VBA开发专栏：Access开发专栏：Excel免费教程：整理实属不易，如果觉得有用，请帮忙点个赞及关注我 @小辣椒高效Office 如果需要更多函数，也可在评论区留言。}