冯修聿

 标识符：     在程序运行的过程中，通常需要将计算结果保存下来，在后面使用，程序中使用的数据都保存在计算机的内存中。数据保存在内存中，需要使用某种方式引用它，就必须给这些内存一个名称，这就是标识符。定义标识符时应该遵循以下规则：1、以字符开头，包含字母、数字和下划线，不区分大小写。2、长度不能超过255个字符3、不能使用VBA的关键字4、同一个过程内不能使用重复的名称常量：     在程序运行...

Sub 插入图片()Dim filenames As String Dim filefilter1 As String filefilter1 = ("所有图片文件（*.jpg;*.bmp;*.png;*.gif）,*.jpg;*.bmp;*.png;*.gif")    '所有图片文件后面的括号为中文括号filenames = Application.GetOpenFilename(fi...

实例图如下：    代码如下：Sub july232()For Each y In Worksheetsx = y.UsedRange.Rows.CountFor i = 2 To xx = y.Cells(i, "B")a = y.Cells(i, "A")c = y.Cells(i, "C")If x <= 3 Thenc = ...

代码如下：Sub july234()  Dim i As Integer  For Each Y In Worksheets  X = Y.UsedRange.Rows.Count  For i = 1 To X  If Cells(i, "A") = 0 Then  Cells(i, "A").EntireRow.Delete '在A列中删除0所在行  End If ...

代码如下：Private Sub July241()  Sheets("sheet1").Cells.Font.ColorIndex = 2 '防止文档越权使用者看到内容 If Application.InputBox("请输入操作权限密码：") = 123 Then  Sheets("sheet1").Cells.Font.ColorIndex = 56 '输入正确的密码之后文字...

Sub kuangxian()Range("A27:C38").Select '选择区域    Selection.Borders(xlDiagonalDown).LineStyle = xlNone    Selection.Borders(xlDiagonalUp).LineStyle = xlNone    With Selection.Borders(xlEdgeLeft)...

代码如下：Function Fac(num) '自定义一个参数的函数，要求用户输入一个数，然后求其阶乘Dim i As IntegerDim total As Longtotal = 1For i = 1 To numtotal = total * iNext iFac = totalEnd Function使用该函数的方法在和其他固有的函数一样，在函数选项...

可以通过自定义函数处理,以以下为例：当销售额小于200000时，以销售额的8%作为奖金金额 ；当销售额200001到400000时，以销售额的10%作为奖金金额 ；当销售额大于400000时，以销售额的15%作为奖金金额 ；代码如下： Function GetReward(Saleprice, Number) '定义多个参数的函数Dim total As Long  t...

代码如下：Function sheettype(sheet As range)Select Case True Case Application.WorksheetFunction.IsText(sheet)sheettype = "文本"Case Application.WorksheetFunction.IsLogical(sheet)sheettype = "逻辑值"...

Function firstnoblank(myrange As range) Dim sheet As rangeFor Each sheet In myrange '遍历区域里的每一个单元格If Not IsNull(sheet) And sheet <> "" Thenfirstnoblank = sheet.ValueExit FunctionEnd I...

例子：Sub Auto_open() '一种方法是将宏的名称改为这个即可MsgBox "欢迎回来继续学习VBA！"End Sub还有一种方法就是使用VBE在工作簿的Open事件中编写VBA过程。 ...

Sub xcj()mypath = ThisWorkbook.Path '获取当前工作簿的路径Filename = Dir(mypath & "\*.xls") '获取当前路径下所有的文件名称，这里所指工作簿的名称名称都一样，如下，只是结尾的数字不一样Set wk_zb = Workbooks("访问统计表-Office 高级应用与VBA（INF0402A）-2018年04月0...

比如 连续自然数m到n求和函数1、选择“工具”——“宏”——“Visual Basic编辑器”命令(或按快捷键“Alt+F11”)，打开Visual Basic编辑界面。2、选择“插入“——”模块”命令，插入新模块——如模块1。3、在“代码窗口”中输入下面代码：Function V(m,n)V = n*(m+n)/2End Function ...

Sub 存成html()  Application.ScreenUpdating = False            Dim FileName As String      FileName = InputBox("请输入文件名")      Selection.Copy      Documents.Add DocumentType:=wdNewBlankDocument...

Sub 合并当前工作簿下的所有工作表()Application.ScreenUpdating = FalseFor j = 1 To Sheets.CountIf Sheets(j).Name <> ActiveSheet.Name ThenX = Range("A65536").End(xlUp).Row + 1Sheets(j).UsedRange.Copy Cells(X, 1)...

Sub text1()Worksheet.Add.Name="汇总"For Each Sheet In Worksheetsk = k + 1x = y.usedRange.Rows.Countsheets("汇总").Cells(k, 1) = Sheet.Namesheets("汇总").Cells(k, 2) =xNextEnd Sub

将每个工作表的总分列进行操作：判断总分，<60,底色为红色,60-100,底色为蓝色，100以上：底色为绿色Sub test()For Each y In Worksheetsx = y.UsedRange.Rows.CountFor i = 2 To xIf x <= 60 Then x = y.Cells(i, "I") y.Cells(i, "I").Interior. Colo...

Sub AreaOfCircle()Const PI As Single = 3.14r = Val(InputBox("请输入半径"))Range("A1").Value = rDim areaarea = PI * r ^ 2MsgBox "圆的面积" & areaEnd Sub

注：这里的rng=1是出勤，rng=0是未出勤Sub i统计出勤()Dim rng As Range            '定义范围For Each rng In [b2:b32]    'For Each语句 外循环   If rng = 1 Then          'ElseIf循环体 内循环     sum1 = sum1 + 1    ElseIf rng = 0 Then     ...

Sub i个人所得税()For Each Sheet In WorksheetsFor i = 2 To xx = Sheet.UsedRange.Rows.CountDim a%, b% a = Sheet.Cells(i, "I") If a < 3500 Then Range(Sheet.Cells(i, "J")) = 0 ElseIf a - 3500 < 1500 Then...

使用宏与编写VBA代码的方法也可轻松实现工资条的制作，将宏指定到按钮上，每次只要轻点按钮即可实现工资条的制作。Sub 工资条()Dim x AsIntegerRange("A1").SelectFor x = 1 ToRange("a1048576").End(xlUp).Row - 2ActiveCell.Rows("1:1").EntireRow.SelectSelection.CopyAct...

工作表的C-H列隐藏Sub test()For Each y In Worksheetsy.Columns("C:H").Hidden = TrueNextEnd Sub工作表的4到5行隐藏Sub test()For Each y In Worksheetsy.Rows("4:5").Hidden = TrueNextEnd Sub

获取当前的系统时间在【A1】中，系统中的年在[B1],月在【C1】日在【D1】Sub D()ActiveCell.FormulaR1C1 = "=NOW()"    Range("B1").Select    ActiveCell.FormulaR1C1 = "=year"    Range("B1").Select    ActiveCell.FormulaR1C1 = "=YEAR(RC[-1...

Sub 批量删除文件()     mypath = ThisWorkbook.Path     f = Dir(mypath & "\*.xlsx")  '查找当前路径下符合条件的文件名    While f <> ""  '一直到F找不到合条件的就结束循环           If f <> "test.xls" Then 不为test.xls 则删除      ...

Sub 批量COPY工作表到工作簿()  '将工作表中的内容，分表COPY到另一个工作簿中    '准备一个工作簿，选取需要COPY的工作表（区域），贴,保存，关闭    mypath = ThisWorkbook.Path  '代码所在工作簿的文件夹路径    Set zb = ThisWorkbook '代码所在的工作簿For Each biao In zb.Sheets         Se...

Sub 根据身份证号码确定性别()sid = InputBox("请输入身份证号码：")i = Len(sid)If i <> 15 And i <> 18 Then              '判断身份证号长度是否正确MsgBox "身份证号码只能为15位或18位！"Exit SubEnd IfIf i = 15 Then                         ...

1，数据形式如下，要做成的效果也如下：    需求：将每个人的成绩单独生成一张柱状图。Sub 批量生成图表()Dim mydatesourse As Range For i = 2 To 5    Set mydatesoure = Sheets("学生成绩表").Range("a" & i & ":d" & i)    Charts.Add   ...