首页 最新文章网站编程正文

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

imitker 编程 1262 5

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


©️公众号:思考者文刀

评论

精彩评论
  • 2024-07-11 08:06:19

    楼主很有经验啊!http://usv8.xzsjesc.cn

  • 2024-07-11 06:26:48

    关注一下!http://tkx7.zhujibus.com

  • 2024-07-11 00:19:19

    楼主该去看心理医生了!http://hn3yau.juyuangroup.com

  • 2024-07-09 03:05:32

    勤奋灌水,天天向上!http://www.dbsdata.com.cn

  • 2024-07-08 20:25:30

    有钱、有房、有车,人人都想!http://m.zjchuzhou.com

百度搜索

站点信息

  • 文章总数:436
  • 页面总数:9
  • 分类总数:30
  • 标签总数:924
  • 评论总数:517
  • 浏览总数:1806880
觉得有用就打赏吧
关注本站公众号,享受更多服务!
联系方式
合作微信:itker0110
新媒体:Excel加油站(抖音/小红书/哔哩/头条)
公众号:左手Excel右手VBA
知乎:Excel其实很简单
Copyright2015-2024.Powered by ©️云水客 | 网站地图 | 辽ICP备14000512号-5
您是本站第702名访客 今日有0篇新文章