Excel VBA使用总结

都说世界上最好的语言就是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 Integer
    Dim columnCount As Integer
    Dim xlWorksheet1 As Worksheet
    Dim xlWorksheet2 As Worksheet
    Dim i As Integer
    Dim j As Integer
    
    //TableInfo 就是某一页的名字
    Set xlWorksheet1 = xlWorkbook.Sheets("TableInfo")
    Set xlWorksheet2 = xlWorkbook.Sheets("ColumnInfo")
    tableCount = xlWorksheet1.[B65535].End(xlUp).Row
    columnCount = xlWorksheet2.[B65535].End(xlUp).Row
    
    
    With xlWorksheet1
        For i = 4 To tableCount
            For j = 2 To 30
                .Cells(i, j).Value = ""
           
            Next j
        Next
    End With
    With xlWorksheet2
        For i = 4 To columnCount
            For j = 2 To 50
                .Cells(i, j).Value = ""

            Next j
        Next
    End With
End Sub

2.2vba设密码

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

Private Sub Workbook_Open()
    Worksheets("TemplateVersion").Activate
    
    'lock tableInfo function introduction
    ThisWorkbook.Sheets("TableInfo").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, AllowFormattingRows:=True, Password:=8888
    ActiveSheet.EnableSelection = xlUnlockedCells
    
    'lock columnInfo function introduction
    ThisWorkbook.Sheets("ColumnInfo").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, AllowFormattingRows:=True, Password:=8888
    ActiveSheet.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 Collection

Type SYSTEM_TBL
    System As String
    Table As String
    Type As String
    Condition As String
    ColumnCheck As Boolean
End Type

Public Type StackStruct
    Size As Integer
    Pointer As Integer
    MaxElementCount As Integer
    Element() As Integer
End Type

'for method 23,get table properties,pk-pk or pks-pk
Sub CHECK_SRC_TYPE_RULE_PUBLIC()
   
    Dim xlWorksheet2 As Worksheet
    Dim columnCount As Integer
    Dim PKCount As Integer
    Dim FKCount As Integer
    Dim i As Integer

    Dim BeginRow As Integer, firstRow As Integer, EndRow As Integer

    PKCount = 33
    FKCount = 34
    BeginRow = 4
    Set xlWorksheet2 = ThisWorkbook.Sheets("ColumnInfo")
    columnCount = xlWorksheet2.[A65535].End(xlUp).Row
    Set columnInfoCollection = New Collection

    With 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 columnCount
        
            Dim fullQualifiedName As String
            Dim fullQualifiedNameNext As String
            fullQualifiedName = .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) <> "" Then
            
                If fullQualifiedName <> fullQualifiedNameNext Then
                    firstRow = BeginRow
                    EndRow = i
                    BeginRow = i + 1

                    PKCount = 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 If
             End If
        Next i
        
        For i = 4 To columnCount
        
            fullQualifiedName = .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 exist
             If 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 exist
             If Contains(columnInfoCollection, fullQualifiedName & "FKCount") Then
                 .Cells(i, 34) = columnInfoCollection.Item(fullQualifiedName & "FKCount")
             End If
           
        Next i
        
    End With
                 
End Sub

Sub Check_CDM()
    Dim Status_Base As Boolean
    Dim Status_Detail As Boolean
 '   Dim SystemTables(MAX_ITTABLE_LEN) As SYSTEM_TBL
    Dim xlErrSheet As Worksheet
    Dim ctrErrBase As Integer
    Dim ctrErrDetail As Integer
    Dim xlWorksheet1 As Worksheet
    Dim xlWorksheet2 As Worksheet
    
    Application.ScreenUpdating = False
    Application.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 Worksheet
    Dim xlWorksheet1 As Worksheet
    Dim xlWorksheet2 As Worksheet
    Dim i As Integer
    Dim j As Integer
    Dim tableCount As Integer
    Dim columnCount As Integer
    Dim errCountTab As Integer
    Dim errCountCol As Integer
    
    
    Set xlErrSheet = xlWorkbook.Sheets("CheckReport")
    Set xlWorksheet1 = xlWorkbook.Sheets("TableInfo")
    Set xlWorksheet2 = xlWorkbook.Sheets("ColumnInfo")
    
    tableCount = xlWorksheet1.[B65535].End(xlUp).Row
    columnCount = xlWorksheet2.[B65535].End(xlUp).Row
    errCountTab = xlErrSheet.[B65535].End(xlUp).Row
    errCountCol = xlErrSheet.[E65535].End(xlUp).Row
    
    With 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 Then
            For i = 8 To errCountTab
                For j = 2 To 6
                    .Cells(i, j).Value = ""
                    .Cells(i, j).Value = ""
                Next j
            Next
        Else
            For i = 8 To errCountCol
                For j = 2 To 6
                    .Cells(i, j).Value = ""
                    .Cells(i, j).Value = ""
                Next j
            Next
        End If
    End With
    
    With xlWorksheet1
        'https://access-excel.tips/excel-vba-color-code-list/
        'color index values for reference
        With .Range(.Cells(4, 2), .Cells(tableCount, 5))
            ' 20
            .Interior.ColorIndex = 33
        End With
        With .Range(.Cells(4, 6), .Cells(tableCount, 26))
            ' 20
            .Interior.ColorIndex = 44
        End With
        With .Range(.Cells(tableCount + 1, 2), .Cells(tableCount + 5, 26))
            .Interior.ColorIndex = 44
        End With
            
    End With
    
    With xlWorksheet2
        'https://access-excel.tips/excel-vba-color-code-list/
        'color index values for reference
        With .Range(.Cells(4, 2), .Cells(columnCount, 6))
            ' -4142
            .Interior.ColorIndex = 33
        End With
        With .Range(.Cells(4, 7), .Cells(columnCount, 30))
            ' 20
            .Interior.ColorIndex = 44
        End With
        With .Range(.Cells(columnCount + 1, 2), .Cells(columnCount + 5, 30))
            .Interior.ColorIndex = 44
        End With
    End With
    
End Sub

2.4使用正则

在VBA的界面要开启RegExp

Public Type StackStruct
    Size As Integer
    Pointer As Integer
    MaxElementCount As Integer
    Element() As Integer
End Type

Dim abcCollection As Collection
Dim result As StackStruct
----------------------------------------------------
Sub test1()
    Dim Reg As New RegExp
    Dim match As Object
    Dim matches As Object
    Dim str As String
    
    With Reg
    .Global = True
    .IgnoreCase = True
    .Pattern = "123-([0-9]+)"
    End With
    
    str = "321-123-000-123-658-123-789-123-464-123-658"
    Set matches = Reg.Execute(str)
    For Each match In matches
        Debug.Print match.SubMatches(0)
    Next match
End Sub

2.5使用stack

来判断括号对称的问题

Option Explicit
Public Type StackStruct
    Size As Integer
    Pointer As Integer
    MaxElementCount As Integer
    Element() As Integer
End Type
----------------------------------------------------
' create a stack棧
Public Function CreateStack(StackSize As Integer) As StackStruct
        Dim h As StackStruct
        h.Pointer = -1
        h.Size = 0
        h.MaxElementCount = StackSize
        ReDim h.Element(StackSize - 1) As Integer
        CreateStack = h
End Function
----------------------------------------------------
' Determines if the stack is empty
Public Function StackEmpty(h As StackStruct) As Boolean
        StackEmpty = (h.Pointer = -1)
End Function
----------------------------------------------------
' Determines if the stack is full
Public Function StackFull(h As StackStruct) As Boolean
        StackFull = (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 False
        If StackFull(h) Then
            Push = False
            Exit Function
        Else
            h.Pointer = h.Pointer + 1
            h.Element(h.Pointer) = Ikey
            h.Size = h.Size + 1
        End If
End Function
---------------------------------------------------
'將Pops the element off the stack
Public Function Pop(ByRef h As StackStruct) As Variant
        If StackEmpty(h) Then
                Pop = False
        Else
                Pop = h.Element(h.Pointer)
                h.Pointer = h.Pointer - 1
                h.Size = h.Size - 1
        End If
End Function
----------------------------------------------------
Function symmetrical(content As String) As Boolean
    Dim abcd As String
    Dim arr As Variant
    Dim i As Integer
    Dim result As String
    Dim contentLong As Integer
    Dim stack As StackStruct
    
    stack = CreateStack(20)
    contentLong = Len(content)
    For i = 1 To contentLong
        result = Mid(content, i, 1)
        If (result = "[") Then
            If StackFull(stack) Then
                
            Else
                stack.Pointer = stack.Pointer + 1
                stack.Size = stack.Size + 1
            End If
        ElseIf (result = "]") Then
            If StackEmpty(stack) Then
                'Debug.Print "no pair"
                symmetrical = False
                Exit Function
            Else
                stack.Pointer = stack.Pointer - 1
                stack.Size = stack.Size - 1
            End If
        Else
        End If
    Next
    'final result
    If StackEmpty(stack) Then
        'Debug.Print "pair"
        symmetrical = True
    Else
        'Debug.Print "no pair"
        symmetrical = False
    End If
End Function
---------------------------------------------------
Sub text9()
    Dim name As String
   
    name = "abc][][]"
    Call symmetrical(name)
End Sub