Excel VBA

1.入门
- 1.1开启VBA之旅
2.语法
- 2.1清除单元格内容
- 2.2vba设密码
- 2.3以前的代码
- 2.4使用正则
- 2.5使用stack

都说世界上最好的语言就是PPT,工作报告，年度总结。。。。
到处都有它的身影，更是被高手设计的惟妙惟肖。
今天，我们不争第一，勇夺第二。

还在为设计报表而发愁吗，还在为统计数据而苦恼吗，今天，它来了，它跳着芭蕾走来了（一片稀稀落落的掌声），有个大神说，Excel除了不能给你生孩子，就没有它搞不定的，这？？？？

1.入门

Excel VBA官方文档: Office Visual Basic For Application Document.

Visual Basic for Applications（VBA）是Visual Basic的一种宏语言，是微软开发出来在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。主要能用来扩展Windows的应用程式功能，也可说是一种应用程式视觉化的Basic脚本。

 vba的好处：1.规范用户操作，控制用户的操作行为2.操作界面人性化,方便用户操作3.自动化办公,可以将多个步骤的手工操作通过一步来实现4.Word和ppt里面也可以用vba来操作 5.实现一些vb无法实现的功能6.用vba制作excel登录系统7.利用vba可以excel内轻松开发功能强大的自动化程序

1.1开启VBA之旅

首先，普及一下基础知识
每层关系都是有上限的

2.语法

语法没有太多要讲的，不懂自己就录制宏，然后再修修改改。

Option Explicit種竡琌祘Α家舱い眏–祘Α家舱跑计常ゲ斗絋Ч俱㎝﹚竡ㄤ嘿,絛瞅籔.
还真的乱码了，留着做个纪念Option Explicit 的意义1.在程式模组中强迫每个在程式模组里的变数必须明确完整的宣告和定义其名称，范围和类型2.并且可以避免打错变数或在有效范围内设定两个相同的变数名称

2.1清除单元格内容

Sub clearContent(xlWorkbook As Workbook)Dim tableCount As IntegerDim columnCount As IntegerDim xlWorksheet1 As WorksheetDim xlWorksheet2 As WorksheetDim i As IntegerDim j As Integer//TableInfo 就是某一页的名字Set xlWorksheet1 = xlWorkbook.Sheets("TableInfo")Set xlWorksheet2 = xlWorkbook.Sheets("ColumnInfo")tableCount = xlWorksheet1.[B65535].End(xlUp).RowcolumnCount = xlWorksheet2.[B65535].End(xlUp).RowWith xlWorksheet1For i = 4 To tableCountFor j = 2 To 30.Cells(i, j).Value = ""Next jNextEnd WithWith xlWorksheet2For i = 4 To columnCountFor j = 2 To 50.Cells(i, j).Value = ""Next jNextEnd With
End Sub

2.2vba设密码

乱码问题很恶心，我也没解决，最后就是都用英文
如果打开excel，就要启动的方法，都放在这里

Private Sub Workbook_Open()Worksheets("TemplateVersion").Activate'lock tableInfo function introductionThisWorkbook.Sheets("TableInfo").SelectActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, AllowFormattingRows:=True, Password:=8888ActiveSheet.EnableSelection = xlUnlockedCells'lock columnInfo function introductionThisWorkbook.Sheets("ColumnInfo").SelectActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, AllowFormattingRows:=True, Password:=8888ActiveSheet.EnableSelection = xlUnlockedCells
End Sub

2.3以前的代码

很多都不记得了，这是留给我自己看的，谢谢

Option Explicit'TableInfo max count
Const MAX_ITTABLE_LEN = 5000
'ColumnInfo max count
Const MAX_TABLECOL_LEN = 5000
Const MAX_COL_NUMBER = 1000
Const MAX_SOURCE_COLUMN_NUM = 100
Const PGM_PASSWORD = "zaq12wsx"
Dim columnInfoCollection As Collection
Dim BlankCollection As Collection
Dim ISACollection As Collection
Dim TableInfoRowErrCollection As Collection
Dim ColumnInfoRowErrCollection As CollectionType SYSTEM_TBLSystem As StringTable As StringType As StringCondition As StringColumnCheck As Boolean
End TypePublic Type StackStructSize As IntegerPointer As IntegerMaxElementCount As IntegerElement() As Integer
End Type

'for method 23,get table properties,pk-pk or pks-pk
Sub CHECK_SRC_TYPE_RULE_PUBLIC()Dim xlWorksheet2 As WorksheetDim columnCount As IntegerDim PKCount As IntegerDim FKCount As IntegerDim i As IntegerDim BeginRow As Integer, firstRow As Integer, EndRow As IntegerPKCount = 33FKCount = 34BeginRow = 4Set xlWorksheet2 = ThisWorkbook.Sheets("ColumnInfo")columnCount = xlWorksheet2.[A65535].End(xlUp).RowSet columnInfoCollection = New CollectionWith xlWorksheet2'Construct the ColumnInfoCollection to keep track of every combination of :' 1. SYS_ID+DB_NAME+SCHEMA_NAME+TABLENAME+'PKCount'' 2. SYS_ID+DB_NAME+SCHEMA_NAME+TABLENAME+'fKCount'For i = 4 To columnCountDim fullQualifiedName As StringDim fullQualifiedNameNext As StringfullQualifiedName = .Range("B" & i) & "-" & .Range("C" & i) & "-" & .Range("D" & i) & "-" & .Range("E" & i)fullQualifiedNameNext = .Range("B" & i + 1) & "-" & .Range("C" & i + 1) & "-" & .Range("D" & i + 1) & "-" & .Range("E" & i + 1)If .Range("A" & i) <> "" ThenIf fullQualifiedName <> fullQualifiedNameNext ThenfirstRow = BeginRowEndRow = iBeginRow = i + 1PKCount = Application.WorksheetFunction.CountIf(.Range("M" & firstRow & ":M" & EndRow), "P")FKCount = Application.WorksheetFunction.CountIf(.Range("O" & firstRow & ":O" & EndRow), "<>")columnInfoCollection.Add PKCount, fullQualifiedName & "PKCount"columnInfoCollection.Add FKCount, fullQualifiedName & "FKCount"End IfEnd IfNext iFor i = 4 To columnCountfullQualifiedName = .Range("B" & i) & "-" & .Range("C" & i) & "-" & .Range("D" & i) & "-" & .Range("E" & i)'Check If the collection contains the Key, get value from it iff key existIf Contains(columnInfoCollection, fullQualifiedName & "PKCount") Then.Cells(i, 33) = columnInfoCollection.Item(fullQualifiedName & "PKCount")End If'Check If the collection contains the Key, get value from it iff key existIf Contains(columnInfoCollection, fullQualifiedName & "FKCount") Then.Cells(i, 34) = columnInfoCollection.Item(fullQualifiedName & "FKCount")End IfNext iEnd WithEnd Sub

Sub Check_CDM()Dim Status_Base As BooleanDim Status_Detail As Boolean'   Dim SystemTables(MAX_ITTABLE_LEN) As SYSTEM_TBLDim xlErrSheet As WorksheetDim ctrErrBase As IntegerDim ctrErrDetail As IntegerDim xlWorksheet1 As WorksheetDim xlWorksheet2 As WorksheetApplication.ScreenUpdating = FalseApplication.StatusBar = ""Set xlErrSheet = ThisWorkbook.Sheets("CheckReport")Set xlWorksheet1 = ThisWorkbook.Sheets("TableInfo")Set xlWorksheet2 = ThisWorkbook.Sheets("ColumnInfo")'Call xlErrSheet.Unprotect(PGM_PASSWORD)'Call xlWorksheet1.Unprotect(PGM_PASSWORD)'Call xlWorksheet2.Unprotect(PGM_PASSWORD)调用下面的方法Call Check_CDM_FILE_Initial(ThisWorkbook)Call CHECK_SRC_TYPE_RULE_PUBLIC
End Sub

Sub Check_CDM_FILE_Initial(xlWorkbook As Workbook)Dim xlErrSheet As WorksheetDim xlWorksheet1 As WorksheetDim xlWorksheet2 As WorksheetDim i As IntegerDim j As IntegerDim tableCount As IntegerDim columnCount As IntegerDim errCountTab As IntegerDim errCountCol As IntegerSet xlErrSheet = xlWorkbook.Sheets("CheckReport")Set xlWorksheet1 = xlWorkbook.Sheets("TableInfo")Set xlWorksheet2 = xlWorkbook.Sheets("ColumnInfo")tableCount = xlWorksheet1.[B65535].End(xlUp).RowcolumnCount = xlWorksheet2.[B65535].End(xlUp).RowerrCountTab = xlErrSheet.[B65535].End(xlUp).RowerrCountCol = xlErrSheet.[E65535].End(xlUp).RowWith xlErrSheet' Clean Up the Check Report Header.Cells(2, 3).Value = "No Error".Cells(3, 3).Value = "".Cells(4, 3).Value = ""' Clean Up the Check Report 郎膀セ戈癟(TableInfo)If errCountTab > errCountCol ThenFor i = 8 To errCountTabFor j = 2 To 6.Cells(i, j).Value = "".Cells(i, j).Value = ""Next jNextElseFor i = 8 To errCountColFor j = 2 To 6.Cells(i, j).Value = "".Cells(i, j).Value = ""Next jNextEnd IfEnd WithWith xlWorksheet1'https://access-excel.tips/excel-vba-color-code-list/'color index values for referenceWith .Range(.Cells(4, 2), .Cells(tableCount, 5))' 20.Interior.ColorIndex = 33End WithWith .Range(.Cells(4, 6), .Cells(tableCount, 26))' 20.Interior.ColorIndex = 44End WithWith .Range(.Cells(tableCount + 1, 2), .Cells(tableCount + 5, 26)).Interior.ColorIndex = 44End WithEnd WithWith xlWorksheet2'https://access-excel.tips/excel-vba-color-code-list/'color index values for referenceWith .Range(.Cells(4, 2), .Cells(columnCount, 6))' -4142.Interior.ColorIndex = 33End WithWith .Range(.Cells(4, 7), .Cells(columnCount, 30))' 20.Interior.ColorIndex = 44End WithWith .Range(.Cells(columnCount + 1, 2), .Cells(columnCount + 5, 30)).Interior.ColorIndex = 44End WithEnd WithEnd Sub

2.4使用正则

在VBA的界面要开启RegExp

Public Type StackStructSize As IntegerPointer As IntegerMaxElementCount As IntegerElement() As Integer
End TypeDim abcCollection As Collection
Dim result As StackStruct
----------------------------------------------------
Sub test1()Dim Reg As New RegExpDim match As ObjectDim matches As ObjectDim str As StringWith Reg.Global = True.IgnoreCase = True.Pattern = "123-([0-9]+)"End Withstr = "321-123-000-123-658-123-789-123-464-123-658"Set matches = Reg.Execute(str)For Each match In matchesDebug.Print match.SubMatches(0)Next match
End Sub

2.5使用stack

来判断括号对称的问题

Option Explicit
Public Type StackStructSize As IntegerPointer As IntegerMaxElementCount As IntegerElement() As Integer
End Type
----------------------------------------------------
' create a stack棧
Public Function CreateStack(StackSize As Integer) As StackStructDim h As StackStructh.Pointer = -1h.Size = 0h.MaxElementCount = StackSizeReDim h.Element(StackSize - 1) As IntegerCreateStack = h
End Function
----------------------------------------------------
' Determines if the stack is empty
Public Function StackEmpty(h As StackStruct) As BooleanStackEmpty = (h.Pointer = -1)
End Function
----------------------------------------------------
' Determines if the stack is full
Public Function StackFull(h As StackStruct) As BooleanStackFull = (h.Size = h.MaxElementCount)
End Function
----------------------------------------------------
'Push the element onto the stack
Public Function Push(ByRef h As StackStruct, Ikey As Integer) As Boolean'if stack full,return FalseIf StackFull(h) ThenPush = FalseExit FunctionElseh.Pointer = h.Pointer + 1h.Element(h.Pointer) = Ikeyh.Size = h.Size + 1End If
End Function
---------------------------------------------------
'將Pops the element off the stack
Public Function Pop(ByRef h As StackStruct) As VariantIf StackEmpty(h) ThenPop = FalseElsePop = h.Element(h.Pointer)h.Pointer = h.Pointer - 1h.Size = h.Size - 1End If
End Function
----------------------------------------------------
Function symmetrical(content As String) As BooleanDim abcd As StringDim arr As VariantDim i As IntegerDim result As StringDim contentLong As IntegerDim stack As StackStructstack = CreateStack(20)contentLong = Len(content)For i = 1 To contentLongresult = Mid(content, i, 1)If (result = "[") ThenIf StackFull(stack) ThenElsestack.Pointer = stack.Pointer + 1stack.Size = stack.Size + 1End IfElseIf (result = "]") ThenIf StackEmpty(stack) Then'Debug.Print "no pair"symmetrical = FalseExit FunctionElsestack.Pointer = stack.Pointer - 1stack.Size = stack.Size - 1End IfElseEnd IfNext'final resultIf StackEmpty(stack) Then'Debug.Print "pair"symmetrical = TrueElse'Debug.Print "no pair"symmetrical = FalseEnd If
End Function
---------------------------------------------------
Sub text9()Dim name As Stringname = "abc][][]"Call symmetrical(name)
End Sub

Excel VBA使用总结相关推荐

Excel VBA 教程
https://www.w3cschool.cn/excelvba/ Excel VBA 编程教程 https://www.yiibai.com/vba VBA教程 http://www.acc ...
Excel VBA附合导线平差自动计算表
这是6,7年前做的一个excel vba自动计算附合导线平差的表格. 对于做测绘的朋友来说,附合导线平差是最基础的技能,目前来说,能平差的软件和工具也很多,像南方的平差易,科傻平差.清华三维平差等,但 ...
编写高效Excel VBA代码的最佳实践(一)
很多Excel VBA文章和图书都介绍过如何优化VBA代码,使代码运行得更快.下面搜集了一些使Excel VBA代码运行更快的技术和技巧,基本上都是实践经验的总结.如果您还有其它优化Excel VBA ...
如何避免在Excel VBA中使用选择
本文翻译自:How to avoid using Select in Excel VBA I've heard much about the understandable abhorrence of ...
【090】Excel VBA 基础
Excel Object Model: Application Object (Excel): Stab Me!!! Font Object (Excel): Stab Me!!! Worksheet ...
cxgrid 行合并单元格_【Excel VBA】如何批量撤销合并单元格？
周末好,之前我们分享了批量合并单元格的VBA小代码,链接参考: [Excel VBA]如何批量合并相同值单元格? 天下大势合久必分.分久必合.分分合合合合分分又合合合再分分分又又合合合合合合合---- ...
Excel VBA中的等价(Eqv)和蕴含(Imp)
在一般的编程语言中,逻辑运算只有四个 - Not - And - Or - Xor 但在Excel VBA中,还有 - Eqv 逻辑等价 - Imp 逻辑蕴含他们的真值表如下现给逻辑等价Eqv和逻 ...
Excel VBA开发中数字签名的管理
Excel 禁用无数字签署的宏网上下载的Excel文件可能含有宏病毒,因此打开Excel文件时最好不要轻易启动宏,同时为了不让"启动宏"的提示每次出现,可以在Excel设置中提高 ...
zemax 宏怎么编写数组_编写Excel VBA程序的10个技巧
学习Excel技术,关注微信公众号: excelperfect 学会一些有趣的技巧或想法,能够有效地提高ExcelVBA编程水平.下面是chandoo.org总结的编写Excel VBA程序的10个技 ...
excel vba 调用webbrowser_Python杀死Excel？我只会用Python来增强Excel！
Excel既是一种祝福,也是一种诅咒.当涉及到足够小的数据和足够简单的操作时,Excel是王者.然而,一旦你发现数据非常多时,它就会变成一种痛苦.当然,你可以使用Excel VBA来解决这些问题,但是 ...

Excel VBA使用总结