VBA编程常见场景的十种常用方法

01 

最后非空单元格的行号及列号

适用场景：动态寻找行列范围，多用于判断循环逻辑的结束行和结束列。

ActiveSheet.Range("F300").End(xlUp).Row
ActiveSheet.Range("A1").End(xlRight).Column

02 

取排名前/后27%的阈值

适用场景：获取一批数据中前或后排在27%处的值，从而得到前或后27%的对象。

=LARGE(R2:R55,ROUND(COUNT(R2:R55)*0.27,0))
=SMALL(R2:R55,ROUND(COUNT(R2:R55)*0.27,0))

03 

匹配行列交叉点

适用场景：先将配条件的行列号获取到，并获取其对应的单元格的值。

=INDEX($A:$BG,MATCH($A$2,$A:$A,0),MATCH(A$3,1:1,0))

04 

排序方法

适用场景：在对行数据进行逻辑处理的时候，某列的值是否发生变化往往作为临界条件，这需要先对行数据进行排序使相同的数据挨在一起。

'wps
    ws.Rows("2:" & ws.UsedRange.Rows.Count + 1).Select
    With ws.Sort
        With .SortFields
            .Clear
            .Add Key:=Range("P2:P" & wsLine), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=""
            .Add Key:=Range("C2:C" & wsLine), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=""
      End With
        .Header = xlNo
        .Orientation = xlSortColumns
        .MatchCase = False
        .SortMethod = xlPinYin
        .SetRange Rng:=Selection
        .Apply
    End With
    
 'excel
        ws.Sort.SortFields.Clear
        ws.Sort.SortFields.Add2 Key:=Range("C2:C" & wsLine) sortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        ws.Sort.SortFields.Add2 Key:=Range("K2:K" & wsLine) SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ws.Sort
            .SetRange Range("A1:N" & wsLine)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

05 

查找数值位置

适用场景：当想知道某值在工作表的什么位置（即所在行列

Set c = ws1.Range("A3:A65535").Find(myValue)  '在对应列中查找
If Not c Is Nothing Then msgbox c.row & c.column

06 

增加批注

适用场景：当汇总数据后还想方便的看到关键明细数据，那么批注或者注释可以做到。

ws2.Range(ws1CLetter & r).AddComment (myCommentYellow)

07 

开始编码模板

适用场景：所有的实现逻辑都会包含这几部分，开始编码前可以快速的搭建起框架。

  '容错处理
    On Error Resume Next
    '变量定义区域
    dim i as integer,j as integer,k as integer
    Dim wk1 As Workbook, wk2 As Workbook, wk3 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    
    '变量初始化区域
    Set wk1 = ActiveWorkbook
    Set ws1 = wk1.Sheets("汇总表")
    Application.StatusBar = "开始处理"
    Application.ScreenUpdating = False
    
    '主逻辑处理区域
    
    '逻辑处理结束区域
    Application.ScreenUpdating = True
    Range("A1").Select
    Application.StatusBar = ""
    MsgBox ("完事了！")

08 

禁用常用功能

适用场景：当工作表的内容需要禁止拷贝复制的时候，可以通过禁止相应的功能实现。

一、Call EnableMenuItem(21, Allow)    '调用cut(21剪切)、19复制、22粘贴、755选择性粘贴

Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)     '激活/禁用向下拖动填充
    Dim cBar As CommandBar                    '声明变量
    Dim cBarCtrl As CommandBarControl
    For Each cBar In Application.CommandBars
        If cBar.Name <> "Clipboard" Then
            Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
            If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
        End If
    Next
End Sub

二、Application.CutCopyMode = False

09 

禁止另存为

适用场景：当工作表的内容需要禁止被另存的时候，需要增加workbook_BeforeSave过程，这个过程应添加到Thisworkbook模块

With targetBook.VBProject.VBComponents(sheetName).CodeModule
        If Not .Find("workbook_BeforeSave", 1, 1, -1, -1) Then  '避免重复写入产生二义性
            .InsertLines startLine, "Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)"
             .InsertLines startLine + 1, " "
            .InsertLines startLine + 2, "    On Error Resume Next"
            .InsertLines startLine + 3, "    Dim response As Long"
            .InsertLines startLine + 4, "    If SaveAsUI = True Then"
            .InsertLines startLine + 5, "    response = MsgBox(" & Chr(34) & " 该工作簿不允许用 另存为 来保存，你要用原工作簿名称来保存吗？" & Chr(34) & ", vbQuestion + vbOKCancel)"
            .InsertLines startLine + 6, "    Cancel = (response = vbCancel)"
            .InsertLines startLine + 7, "   If Cancel = False Then Me.Save" '首行颜色受影响
            .InsertLines startLine + 8, "   Cancel = True"
            .InsertLines startLine + 9, " End If"
            .InsertLines startLine + 10, " End sub"
      End If
 End With

10 

禁用快捷键

适用场景：某个功能往往有很多种操作方法，如果要做的全面禁止，快捷键不应被忽略。

With Application
        Select Case Allow     '允许选择
        Case Is = False       '为假
            .OnKey "^c", ""          '"Ctrl+c"复制快捷键无效，并通知用户
            .OnKey "^v", ""          '"Ctrl+v"粘贴快捷键无效，并通知用户
            .OnKey "^x", ""          '"Ctrl+x"剪切快捷键无效，并通知用户
            .OnKey "+{DEL}", ""      '"+{DEL}"删除快捷键无效，并通知用户
            .OnKey "^{INSERT}", ""   '"Ctrl+{INSERT}"插入快捷键无效，并通知用户
        Case Is = True           '为真
            .OnKey "^c"          '"Ctrl+c"复制快捷键有效
            .OnKey "^v"          '"Ctrl+v"粘贴快捷键有效
            .OnKey "^x"          '"Ctrl+x"剪切快捷键有效
            .OnKey "+{DEL}"      '"+{DEL}"删除快捷键有效
            .OnKey "^{INSERT}"   '"Ctrl+{INSERT}"插入快捷键有效
        End Select               '结束选择
    End With