| 楼主 wen98 |
以下是本人Wen98在VBA工作实践中，为方便查找，备忘性的积累了一些VBA常用的语句\函数\子过程，以提高自己一点工作效率。（仅供参考、引用） 获取名字: WorkbookName主表 = ActiveWorkbook.Name Sheet透视表 = ActiveSheet.Name 选定: Windows(WorkbookName主表).Activate Sheets("取数").Select Range("A1").Select Range("K1:M3").Select 单元格赋值: Range("A1")="Abc" [A1]="Abc" Cells(行, 列)="123.00" 是否显示警告信息: Application.DisplayAlerts = False 'True= 显示警告信息 显示提示信息: MsgBox "包括完整路径的工作簿名称为：" & ThisWorkbook.FullName 选择是否提示: If MsgBox("设为汇总的单元格是:" & Selection.Address & " 确定吗?", vbYesNo) = vbNo Then Exit Sub 关闭薄: Windows(Workbook表).Close 删除子表: Sheets("操作步骤").Delete 或: Sheets(Sheet透视表).Select ActiveWindow.SelectedSheets.Delete 删除行 Rows("2:316").Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp Range("A2").Select 全表复制粘贴: Windows(Workbook表).Activate Sheets("表1").Select Cells.Select '全选 Selection.Copy Windows(WorkbookName主表).Activate Sheets("表2").Select Cells.Select ActiveSheet.Paste Windows(Workbook表).Close 复制值: Workbooks.Open Filename:="存款表.xls" Windows("模板20.xls").Activate Sheets("发布").Select Range("C4:H4").Select Range(Selection, Selection.End(xlDown)).Select 'Shift+Ctrl+下键 ' Range(Selection, Selection.End(xlToRight)).Select 'Shift+Ctrl+右键 ' Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select 'Ctrl+End 键 Selection.Copy Windows("存款表.xls").Activate Sheets("人民币").Select Range("C4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '复制值 保存薄: ActiveWorkbook.Save 新建薄并保存修改结果:(复制区域SUB,在下面） Workbooks.Add WorkbookName新薄 = ActiveWorkbook.Name Call 复制区域SUB((WorkbookName日报表), "发布3", "A1:CF82", (WorkbookName新薄), "Sheet1", "A1") Workbooks(WorkbookName新薄).Close SaveChanges:=True, Filename:=C_PRG路径 & "测试表.xls" 原名保存文件，不显示警告信息框 Application.EnableEvents = False ActiveWorkbook.Save Application.EnableEvents = True 关闭不保存，不显示警告信息框 Application.DisplayAlerts = False '不显示 ThisWorkbook.Close Application.DisplayAlerts = True '显示 是否显示屏幕变化 Application.ScreenUpdating = False Application.ScreenUpdating = True 不显示Excel界面 Application.Visible = False '显示Excel界面 True or False 打开文件: TXT_Name = Application.GetOpenFilename("文本文件(*.txt), *.txt") '获取文件 Workbooks.Open Filename:=TXT_Name Workbooks.Open Filename:=C_PRG路径 & "模板5.XLS" 另一种: If MsgBox("[B1]单元内容应先设为读取的文件名, 准备好了吗?", vbYesNo) = vbNo Then 'Exit Sub XLS_Name = Application.GetOpenFilename("Excel文件(*.xls), *.xls") Range("B1") = XLS_Name Else XLS_Name = Range("B1") '读取的文件名 End If Workbooks.Open Filename:=XLS_Name Workbook表名 = ActiveWorkbook.Name 总行数: 已选区域行数 = Sheets("基金取数").UsedRange.Rows.Count '已选区域行数 或: 已选区域行数 = Selection.Rows.Count '已选定范围的行数 [B1] = 已用区域行数 已选区域右下角坐标 = Cells(Selection.Rows.Count, Selection.Columns.Count).Address MsgBox 已选区域右下角坐标 MsgBox Range("A1:" & 右下角坐标已选区域).Address '矩形范围 右下角坐标 = Cells(Range("A1").End(xlDown).Row,Range("A1").End(xlToRight).Column).Address MsgBox Range("A1:" & 右下角坐标).Address '矩形范围 或: 最后行号 = Range("B5").End(xlDown).Row 'B列最后行号,可用,B5下方不应有空单元格 最后列号 = Range("A4").End(xlToRight).Column 列名 = Columns(最后列号).Address '得出如: $N$N 最后行号 = Cells(Rows.Count, 3).End(xlUp).Row 'C列最后行号,可用 相当于: 最后行号 = Range("C65536").End(xlUp).Row '最后行号,可用,V2003 获取行列坐标: 列 = Selection.Column 行 = Selection.Row 或 列 = ActiveCell.Column 行 = ActiveCell.Row 设置公式(填充):(关联的透视表最后列并不固定) Sheets("透视表").Select 最后列号 = Range("A4").End(xlToRight).Column '最后列号 列名 = Columns(最后列号).Address Sheets("金额").Select 最后行号 = Range("C4").End(xlDown).Row '最后行号 Range("E5").Select ActiveCell.Formula = "=SUMIF(透视表!A:A,B:B,透视表!" & 列名 & ")" '设置公式 Selection.AutoFill Destination:=Range("E5:E" & 最后行号) '填充 消除表内容: ActiveSheet.Cells.Clear 消除内容: Selection.ClearContents 把每个数字转换成9位字符，不足者前面添0, 在单元格输入公式: =REPT(0,9-LEN(A23)) &A23 用代码简化输入(在[代码]工作表中有A列代码,B列名称) 在工作表A列输入代码后,在B列得出名称,B2单元格输入公式: =IF(ISERROR(VLOOKUP(A2,代码!A:B,2,FALSE)),"",VLOOKUP(A2,代码!A:B,2,FALSE)) 冻结窗口 Range("C4").Select ActiveWindow.FreezePanes = True '冻结窗口,C4起 查找包括X的单元格 Cells.Find(what:="X").Activate 行号 = Cells.Find(what:="X").Row 列号 = Cells.Find(what:="X").Column 通过短名(简称)求长名代码 =LOOKUP(0,0*FIND(简称!$A$2:$A$112,A3),简称!$B$2:$B$112) 其中:[简称!$A$2:$A$112] 为简称,[简称!$B$2:$B$112] 为行号,A3为网点全名 ================================================================================ Sub 复制区域SUB(源薄名 As String, 源表名 As String, 源区域 As String, 目标薄名 As String, 目标表名 As String, 目标区域 As String) Windows(源薄名).Activate Sheets(源表名).Select Range(源区域).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Windows(目标薄名).Activate Sheets(目标表名).Select Range(目标区域).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '复制值 End Sub ================================================================================ Function 工作表是否存在(表名 As String) As Boolean '自定义函数: 工作表是否存在 Dim i As Long For i = Worksheets.Count To 1 Step -1 If Worksheets(i).Name = 表名 Then Exit For End If Next 工作表是否存在 = IIf(i = 0, False, True) '如果i = 0工作表未找到 End Function 调用: If 工作表是否存在((表名)) = False Then Sheets.Add(after:=Sheets("成表")).Name = 表名 '"成表"之后插入 End If ===================================================================================== Function 工作簿是否打开(sWkbName As String) As Boolean '自定义函数: 工作簿是否打开 '如果要判断一个指定的工作簿是否打开，可以将下面的VBA代码放入标准模块中，然后在子过程中进行调用。 '如果目标工作簿已打开则返回TRUE，否则返回FALSE Dim i As Long For i = Workbooks.Count To 1 Step -1 If Workbooks(i).Name = sWkbName Then Exit For End If Next 工作簿是否打开 = IIf(i = 0, False, True) '如果i = 0工作簿未找到 End Function ================================================================================ Sub 返回模板1() If 工作簿是否打开("模板1.xls") = False Then Workbooks.Open Filename:="F:\报表\日报\prg\模板1.xls" '打开表 End If Windows("模板1.xls").Activate End Sub ===================================================================================== Sub 打开或隐藏列() Sheets("变动表").Select Columns("V:AO").Select Selection.ColumnWidth = IIf(Selection.ColumnWidth > 0, 0, 12) End Sub ======================================================= Sub 打开或隐藏无关表() Worksheets("过渡表").Visible = Not Worksheets("过渡表").Visible 'False 'True Worksheets("汇总单位").Visible = Not Worksheets("汇总单位").Visible 'False 'True End Sub ============================================================= Sub 另存并关闭() ActiveWorkbook.Close SaveChanges:=True, Filename:="test.xls" End Sub ============================================================= Sub 设置片区汇总公式() '用法: 先定位"分行汇总的单元格", 再运行本宏, 即可自动设置片区汇总公式 '分行汇总在最上面,片区汇总在网点下方(片区包含若干网点) 'MsgBox ActiveCell.Column If MsgBox("设为合计汇总的单元格是:" & ActiveCell.Address & " 确定吗?", vbYesNo) = vbNo Then Exit Sub 列 = ActiveCell.Column '自动得出 行0 = ActiveCell.Row '自动得出 Dim A As Variant '片区个数 = 14 A = Array(10, 5, 3, 3, 4, 1, 2, 3, 2, 2, 9, 6, 6, 6) '各片区包含的网点个数(行) 行 = 行0 总计 = "=SUM(" For i = 0 To UBound(A) '确定数组的指定维的最大可用下标。 含 = A(i) 行 = 行 + 含 + 1 'Range(列 & 行).Select Cells(行, 列).Select '可行 ActiveCell.FormulaR1C1 = "=SUM(R[-" & 含 & "]C:R[-1]C)" 总计 = 总计 & "R[" & 行 - 行0 & "]C," Next Cells(行0, 列).Select '可行 ActiveCell.FormulaR1C1 = 总计 & ")" '总计 End Sub |
| 2楼 pblcxpblcx |
谢谢楼主了，学习一上。 |
| 3楼 iolq99 |
看看吧.... 系统下载 猪猪猫论坛 最新QQ签名 qianming.myzzm.com 网址导航jujumao论坛 |
| 4楼 beci426 |
向楼主学习 |
| 5楼 塵封Dè眷戀 |
 |