常用VBA集锦(更新)



  • 建议在代码前面加上

    Option explicit
    Option base 1
    'or 
    Option base 0
    

    这里Option explicit指的是所有变量需要声明变量类型再用(也就是Dim)。Option base指的是默认数组从哪里开始。1指的是从1开始,0指的是从0开始。
    如果你习惯用Python就会知道,python数组默认从0开始。
    而R默认从1开始。

    • 数组Array写入单元格 / 单元格中读取数组Array

    读取

    ‘ Note no “set”
    Dim arr as Variant
    Arr = range(“whateverrange”).value
    
    

    写入: 注意,这里数组最好用二元而非一元数组。
    这里的whateverrange指的是写入的Range的第一个单元格。这样写的好处是不需要自己想arr到底有几行几列

    Dim arr(100, 1)
    
    range(“whateverrange”).resize(UBond(arr, 1), UBond(arr, 2)).Value = arr
    
    • 在不显示弹窗的基础上删除Sheet
    Sub Delete_Sheet_WithoutWarningMessage()
        Application.DisplayAlerts = False
        Sheets("Sheet2").Delete
        Application.DisplayAlerts = True
    End Sub
    
    
    • 如果Sheet不存在,创建Sheet。
    Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
        Dim sht As Worksheet
    
        If wb Is Nothing Then Set wb = ThisWorkbook
        On Error Resume Next
        Set sht = wb.Sheets(shtName)
        On Error GoTo 0
        WorksheetExists = Not sht Is Nothing
    End Function
    
    If WorksheetExists("md_table") = False Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = "md_table"
    
    
    • 在excel的Status bar显示运行的process
    Private Sub ProgressTime(Message As String, purcentage As Single)
    Dim prog_Bar As String
    'progress bar
        prog_Bar = Mid(String(20, ChrW(9632)) + String(20, ChrW(9633)), Round(20 + 1 - purcentage * 20, 0), 20)
        
    'Output
    Application.StatusBar = Message & "  " & prog_Bar
    End Sub
    
    
    • 根据给定的画图
    Private Sub draw_chart(sheet_name As String, graph_type As String, axis_rng As Range, data_rng As Range)
        Dim chart_my    As Shape
        
        For Each chtObj In Worksheets(sheet_name).ChartObjects
            chtObj.Delete
        Next
        
        Select Case graph_type
            Case Is = "Bar Chart"
                Set chart_my = Worksheets(sheet_name).Shapes.AddChart2(-1, XlChartType:=xlBarClustered)
            Case Is = "Column Chart"
                Set chart_my = Worksheets(sheet_name).Shapes.AddChart2(-1, XlChartType:=xlColumnClustered)
            Case Is = "Line Chart"
                Set chart_my = Worksheets(sheet_name).Shapes.AddChart2(-1, XlChartType:=xlLineMarkers)
            Case Is = "3D Column"
                Set chart_my = Worksheets(sheet_name).Shapes.AddChart2(-1, XlChartType:=xl3DColumnClustered)
            Case Is = "3D Bar"
                Set chart_my = Worksheets(sheet_name).Shapes.AddChart2(-1, XlChartType:=xl3DBarClustered)
            Case Is = "3D Line"
                Set chart_my = Worksheets(sheet_name).Shapes.AddChart2(-1, XlChartType:=xl3DLine)
        End Select
        
        chart_my.Chart.SetSourceData Source:=data_rng
        chart_my.Chart.FullSeriesCollection(1).XValues = axis_rng
    End Sub
    
    
    Sub CalculateRunTime_Seconds()
    'PURPOSE: Determine how many seconds it took for code to completely run
    'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
    
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    
    'Remember time when macro starts
      StartTime = Timer
    
    '*****************************
    'Insert Your Code Here...
    '*****************************
    
    'Determine how many seconds code took to run
      SecondsElapsed = Round(Timer - StartTime, 2)
    
    'Notify user in seconds
      MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
    
    End Sub
    


  • Error handling:

    On error resume next
    

    定义变量

    Dim strName As String 
    
    Dim intX As Integer, intY As Integer, intZ As Integer 
    '在下面的语句中,intX 和 intY 都声明为 **** Variant 类型;只有 intZ 声明为 Integer 类型。! 注意!
    Dim intX, intY, intZ As Integer
    

    循环: Do...While

    Do While [Condition]
            [Statement~~strikethrough text~~]
            Loop
    

    加快代码运行

    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    
    [Code]
    
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    

Log in to reply