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
















