VBA编程——范例一

最新推荐文章于 2024-06-22 08:30:38 发布
最新推荐文章于 2024-06-22 08:30:38 发布
阅读量208 收藏
点赞数
文章标签： python
原文链接：https://my.oschina.net/moluyingxing/blog/1933722
版权

2019独角兽企业重金招聘Python工程师标准>>> hot3.png

Excel VBA编程，即宏编程，对于一些比较苛刻的场景，比较有用。比如说批量替换，如果表格中，有1，2，3，4，...，17个村，我要把它们替换成金盆村、木厂村等村的名字时，不得不使用查找替换功能，反复操作17次，如果是只替换一张表格还勉强可以接受，如果有几张表格都需要这种替换，就非常耗时了。另外，就是通过宏编程来实现批量替换。如下：

Sub batch_replace()
Dim vReplace As String, vBeReplace As String, nI As Integer

vReplace = Range("A" & 2).Value

For nI = 1 To 17
    vReplace = Range("A" & nI).Value
    If InStr(vReplace, "17") > 0 Then
        vBeReplace = Replace(vReplace, "17", "高红村")
    ElseIf InStr(vReplace, "16") > 0 Then
        vBeReplace = Replace(vReplace, "16", "天堂村")
    ElseIf InStr(vReplace, "15") > 0 Then
        vBeReplace = Replace(vReplace, "15", "川七村")
    ElseIf InStr(vReplace, "14") > 0 Then
        vBeReplace = Replace(vReplace, "14", "新桥村")
    ElseIf InStr(vReplace, "13") > 0 Then
        vBeReplace = Replace(vReplace, "13", "羊角村")
    ElseIf InStr(vReplace, "12") > 0 Then
        vBeReplace = Replace(vReplace, "12", "天山村")
    ElseIf InStr(vReplace, "11") > 0 Then
        vBeReplace = Replace(vReplace, "11", "鲤云村")
    ElseIf InStr(vReplace, "10") > 0 Then
        vBeReplace = Replace(vReplace, "10", "聪明村")
    ElseIf InStr(vReplace, "9") > 0 Then
        vBeReplace = Replace(vReplace, "9", "湾桥村")
    ElseIf InStr(vReplace, "8") > 0 Then
        vBeReplace = Replace(vReplace, "8", "四新村")
    ElseIf InStr(vReplace, "7") > 0 Then
        vBeReplace = Replace(vReplace, "7", "夹石村")
    ElseIf InStr(vReplace, "6") > 0 Then
        vBeReplace = Replace(vReplace, "6", "河堰村")
    ElseIf InStr(vReplace, "5") > 0 Then
        vBeReplace = Replace(vReplace, "5", "玉泉村")
    ElseIf InStr(vReplace, "4") > 0 Then
        vBeReplace = Replace(vReplace, "4", "高棚村")
    ElseIf InStr(vReplace, "3") > 0 Then
        vBeReplace = Replace(vReplace, "3", "遂安村")
    ElseIf InStr(vReplace, "2") > 0 Then
        vBeReplace = Replace(vReplace, "2", "木厂村")
    ElseIf InStr(vReplace, "1") > 0 Then
        vBeReplace = Replace(vReplace, "1", "金盆村")
    End If

    Range("B" & nI).Value = vBeReplace
Next

End Sub

实现效果如下：

主要涉及到的InStr（包含字符串）、Replace（替换字符串）函数，所以上面的代码还是比较容易懂的。

但是上面的代码有很多缺陷，比如我们只想对选中区域的数字进行替换该怎么办？

下面是第二版代码：

Sub batch_replace()
Dim vReplace As String, vBeReplace As String, nI As Integer
Dim r As Range
Dim column_name As String
Dim column_num As Integer

rem 获取选中数据的列名，比如选中的是A列，则返回值为A
column_name = Mid(Selection.Cells(1, 1).Address, 2, 1)

For Each r In Selection
    rem 获取列号，比如A2，则返回值为2
    column_num = Mid(r.Address, 4, 2)
    vReplace = r.Value
    If InStr(vReplace, "17") > 0 Then
        vBeReplace = Replace(vReplace, "17", "高红村")
    ElseIf InStr(vReplace, "16") > 0 Then
        vBeReplace = Replace(vReplace, "16", "天堂村")
    ElseIf InStr(vReplace, "15") > 0 Then
        vBeReplace = Replace(vReplace, "15", "川七村")
    ElseIf InStr(vReplace, "14") > 0 Then
        vBeReplace = Replace(vReplace, "14", "新桥村")
    ElseIf InStr(vReplace, "13") > 0 Then
        vBeReplace = Replace(vReplace, "13", "羊角村")
    ElseIf InStr(vReplace, "12") > 0 Then
        vBeReplace = Replace(vReplace, "12", "天山村")
    ElseIf InStr(vReplace, "11") > 0 Then
        vBeReplace = Replace(vReplace, "11", "鲤云村")
    ElseIf InStr(vReplace, "10") > 0 Then
        vBeReplace = Replace(vReplace, "10", "聪明村")
    ElseIf InStr(vReplace, "9") > 0 Then
        vBeReplace = Replace(vReplace, "9", "湾桥村")
    ElseIf InStr(vReplace, "8") > 0 Then
        vBeReplace = Replace(vReplace, "8", "四新村")
    ElseIf InStr(vReplace, "7") > 0 Then
        vBeReplace = Replace(vReplace, "7", "夹石村")
    ElseIf InStr(vReplace, "6") > 0 Then
        vBeReplace = Replace(vReplace, "6", "河堰村")
    ElseIf InStr(vReplace, "5") > 0 Then
        vBeReplace = Replace(vReplace, "5", "玉泉村")
    ElseIf InStr(vReplace, "4") > 0 Then
        vBeReplace = Replace(vReplace, "4", "高棚村")
    ElseIf InStr(vReplace, "3") > 0 Then
        vBeReplace = Replace(vReplace, "3", "遂安村")
    ElseIf InStr(vReplace, "2") > 0 Then
        vBeReplace = Replace(vReplace, "2", "木厂村")
    ElseIf InStr(vReplace, "1") > 0 Then
        vBeReplace = Replace(vReplace, "1", "金盆村")
    End If
    rem 如果选中的是A3单元格，则将替换后的字符串存入A3单元格右边的第一个单元格，即B3中
    Range(Chr(Asc(column_name) + 1) & column_num).Value = vBeReplace
Next

End Sub

上面的代码比第一版的代码要好一些，当然也更复杂一些，但还是有一点小缺陷，那就是行号不能超过两位数，由于时间有限，下次再来改进。

上面的代码通过mid、address函数找出列名、行号，通过asc函数将字符转换成ascii码，加1后再转换成字符，从而找出当前单元格右边的第一个单元格，非常繁琐。

下面是第三版代码：

Sub batch_replace()
Dim vReplace As String, vBeReplace As String, nI As Integer
Dim r As Range

For Each r In Selection
    vReplace = r.Value
    If InStr(vReplace, "17") > 0 Then
        vBeReplace = Replace(vReplace, "17", "高红村")
    ElseIf InStr(vReplace, "16") > 0 Then
        vBeReplace = Replace(vReplace, "16", "天堂村")
    ElseIf InStr(vReplace, "15") > 0 Then
        vBeReplace = Replace(vReplace, "15", "川七村")
    ElseIf InStr(vReplace, "14") > 0 Then
        vBeReplace = Replace(vReplace, "14", "新桥村")
    ElseIf InStr(vReplace, "13") > 0 Then
        vBeReplace = Replace(vReplace, "13", "羊角村")
    ElseIf InStr(vReplace, "12") > 0 Then
        vBeReplace = Replace(vReplace, "12", "天山村")
    ElseIf InStr(vReplace, "11") > 0 Then
        vBeReplace = Replace(vReplace, "11", "鲤云村")
    ElseIf InStr(vReplace, "10") > 0 Then
        vBeReplace = Replace(vReplace, "10", "聪明村")
    ElseIf InStr(vReplace, "9") > 0 Then
        vBeReplace = Replace(vReplace, "9", "湾桥村")
    ElseIf InStr(vReplace, "8") > 0 Then
        vBeReplace = Replace(vReplace, "8", "四新村")
    ElseIf InStr(vReplace, "7") > 0 Then
        vBeReplace = Replace(vReplace, "7", "夹石村")
    ElseIf InStr(vReplace, "6") > 0 Then
        vBeReplace = Replace(vReplace, "6", "河堰村")
    ElseIf InStr(vReplace, "5") > 0 Then
        vBeReplace = Replace(vReplace, "5", "玉泉村")
    ElseIf InStr(vReplace, "4") > 0 Then
        vBeReplace = Replace(vReplace, "4", "高棚村")
    ElseIf InStr(vReplace, "3") > 0 Then
        vBeReplace = Replace(vReplace, "3", "遂安村")
    ElseIf InStr(vReplace, "2") > 0 Then
        vBeReplace = Replace(vReplace, "2", "木厂村")
    ElseIf InStr(vReplace, "1") > 0 Then
        vBeReplace = Replace(vReplace, "1", "金盆村")
    End If
    Rem 当前单元格向右偏移一列
    r.Offset(0, 1) = vBeReplace
Next

End Sub

第三版代码已经接近完美，通过offset函数，大大简化了代码量。唯一觉得不满意的是太多的if...then...elseif...endif这种结构，上面这种情况使用select case...end select这种方式也不太好，个人觉得最好的方式就是使用字典dictionary。

下面是第四版：

Sub batch_replace()
Dim vReplace As String, vBeReplace As String, nI As Integer
Dim r As Range

Dim i As Integer
Dim dict, keys, items

' 创建Dictionary
Set dict = CreateObject("Scripting.Dictionary")
With dict
.Add "17", "高红村"
.Add "16", "天堂村"
.Add "15", "川七村"
.Add "14", "新桥村"
.Add "13", "羊角村"
.Add "12", "天山村"
.Add "11", "鲤云村"
.Add "10", "聪明村"
.Add "9", "湾桥村"
.Add "8", "四新村"
.Add "7", "夹石村"
.Add "6", "河堰村"
.Add "5", "玉泉村"
.Add "4", "高棚村"
.Add "3", "遂安村"
.Add "2", "木厂村"
.Add "1", "金盆村"
End With

keys = dict.keys
items = dict.items
For Each r In Selection
    vReplace = r.Value
    For i = 0 To dict.Count - 1
        If InStr(vReplace, keys(i)) > 0 Then
            vBeReplace = Replace(vReplace, keys(i), items(i))
            Exit For
        End If
    Next
    Rem 当前单元格向右偏移一列
    r.Offset(0, 1) = vBeReplace
Next

End Sub

本着学习的目的，遍历dictionary可以采用for each....in..的方式，

第五版代码如下：

Sub batch_replace()
Dim vReplace As String, vBeReplace As String, nI As Integer
Dim r As Range
Dim i As Integer
Dim key As Variant
Dim dict As Object

' 创建Dictionary
Set dict = CreateObject("Scripting.Dictionary")
With dict
.Add "17", "高红村"
.Add "16", "天堂村"
.Add "15", "川七村"
.Add "14", "新桥村"
.Add "13", "羊角村"
.Add "12", "天山村"
.Add "11", "鲤云村"
.Add "10", "聪明村"
.Add "9", "湾桥村"
.Add "8", "四新村"
.Add "7", "夹石村"
.Add "6", "河堰村"
.Add "5", "玉泉村"
.Add "4", "高棚村"
.Add "3", "遂安村"
.Add "2", "木厂村"
.Add "1", "金盆村"
End With

For Each r In Selection
    vReplace = r.Value
    For Each key In dict.keys
        If InStr(vReplace, key) > 0 Then
            vBeReplace = Replace(vReplace, key, dict(key))
            Exit For
        End If
    Next key
    Rem 当前单元格向右偏移一列
    r.Offset(0, 1) = vBeReplace
Next

End Sub

最后，可以通过冒号"："将多行代码合并为一行。

第六版代码如下：

Sub batch_replace()
Dim vReplace As String, vBeReplace As String
Dim r As Range
Dim i As Integer
Dim key As Variant
Dim dict As Object

' 创建Dictionary
Set dict = CreateObject("Scripting.Dictionary")
With dict
.Add "17", "高红村": .Add "16", "天堂村": .Add "15", "川七村": .Add "14", "新桥村": .Add "13", "羊角村"
.Add "12", "天山村": .Add "11", "鲤云村": .Add "10", "聪明村": .Add "9", "湾桥村": .Add "8", "四新村"
.Add "7", "夹石村": .Add "6", "河堰村": .Add "5", "玉泉村": .Add "4", "高棚村": .Add "3", "遂安村"
.Add "2", "木厂村": .Add "1", "金盆村"
End With

For Each r In Selection
    vReplace = r.Value
    For Each key In dict.keys
        If InStr(vReplace, key) Then
            vBeReplace = Replace(vReplace, key, dict(key))
            Exit For
        End If
    Next key
    Rem 当前单元格向右偏移一列
    r.Offset(0, 1) = vBeReplace
    vBeReplace = Empty
Next

End Sub

代码的改造可以说永无止境，没有最好，只有更好，经过六个版本的改进，代码已经相当精简。之所以一点一点改进，是因为好代码都是一步一步重构而来，并不是一蹴而就的，这是学习提高的必经阶段。

总结，这是本人第一次通过VBA来操作excel数据表，知识方面主要涉及到VB的语法与Excel自身的框架体系，网上的资料太混乱，代码质量普遍不高。在淘宝上也找了相关的书籍，买了本《别怕，Excel VBA其实很简单》，这本书总体来说，不算深入，也不系统，但简单，代码质量还是挺高的。目前也很难找到比这个更好的入门书籍了。

 

 

 

转载于:https://my.oschina.net/moluyingxing/blog/1933722

weixin_34018169
关注
vba编程
狗剩的专栏
08-07 1万+
VBA 宏编程 相关文件在连接  https://download.csdn.net/download/wei198621/10589098   一 前期安装条件   解压13+Vba6.3+for+WPS+.zip 文件夹内容，执行安装 将后缀从pptx改为pptm，这样可以运行宏   错误 用户定义类型未定义  ADODB.Connection 执行的时候可能会提示如下，...
VBA编程
weixin_43318107的博客
07-09 902
VAB 编程笔记 （关于20块钱的一个记录） 真的灰常遗憾，又错过了20块钱。。。本来五分钟编出来对方有偿，可惜没编出来。要求，某一列单元格包含包含多个空格，要求遇到空格后跳转到后一单元格并且其代号加一。如下图所示 代码实现 使用VBA编程实现，代码如下 Sub peng() Dim g%, t% Dim k As String g = 0 For i = 1 T...
VBA编程实例
09-14
OfficeTips Home || VBA Section || General Section || Download Section || Privacy Policy Useful PowerPoint VBA code snippets More Sharing Services Share | Share on gmail Share on google Share on facebook Share on twitter Determine the current slide in the Slide View mode: Sub SlideIDX() MsgBox "The slide index of the current slide is:" & _ ActiveWindow.View.Slide.SlideIndex End Sub Determine the current slide in Slide Show mode: Sub SlideIDX() MsgBox "The slide index of the current slide is:" & _ ActivePresentation.SlideShowWindow.View.Slide.SlideIndex End Sub Difference between SlideIndex property and SlideNumber property: The SlideIndex property returns the actual position of the slide within the presentation. The SlideNumber property returns the PageNumber which will appear on that slide. This property value is dependent on "Number Slide from" option in the Page Setup. Go to Page Setup and Change the value of "Number Slide from" to 2 and then while on the 1st slide in Slide View run the following Macro Sub Difference() MsgBox "The Slide Number of the current slide is:" & _ ActiveWindow.View.Slide.SlideNumber & _ " while the Slide Index is :" & _ ActiveWindow.View.Slide.SlideIndex End Sub Macro to exit all running slide shows: Sub ExitAllShows() Do While SlideShowWindows.Count > 0 SlideShowWindows(1).View.Exit Loop End Sub Code to refresh current slide during the slide show: Sub RefreshSlide() Dim lSlideIndex As Long lSlideIndex = SlideShowWindows(1).View.CurrentShowPosition SlideShowWindows(1).View.GotoSlide lSlideIndex End Sub Code to reset animation build for the current slide during the slide show: Sub ResetSlideBuilds() Dim lSlideIndex As Long lSlideIndex = SlideShowWindows(1).View.CurrentShowPosition SlideShowWindows(1).View.GotoSlide lSlideIndex, True End Sub Insert a slide after current slide Sub InsertSlide() Dim oView As View With ActivePresentation.Slides Set oView = ActiveWindow.View oView.GotoSlide .Add(oView.Slide.SlideIndex + 1, _ ppLayoutTitleOnly).SlideIndex Set oView = Nothing End With End Sub Copyright 1999-2011 (c) Shyam Pillai. All rights reserved.
VBA编程——范例二
weixin_34237596的博客
09-02 206
2019独角兽企业重金招聘Python工程师标准>>> ...
VBA：VBA常用小代码合集
最新发布
nianfen的博客
06-22 2032
说起排序这个词，想必大家都不陌生，这是数据处理过程中最常见的操作之一，但我们今天聊的不是数据排序，而是如何对工作表排序。我举个例子，如下图所示，一张工作簿有N张工作表，现在需要按升序对其重新排序。操作步骤如下：首先使用以下代码将工作表的名称罗列在当前表的A列.Clear '清除所有.NumberFormat = "@" '设置文本格式End Withk = 1Cells(1, 1) = "目录"For Each sht In Sheets '遍历工作表k = k + 1 '累加个数。
VBA 范例教程(02)：跨应用程序的操作(多文件统计)
风消失的地方
08-02 291
VB、VBA、VBS 到底有什么不同？学习 VBA 以前需要先学习 VB 吗？当然不！学习 VBA 以前是不需要学习 VB 的反而没有 VB 基础的人学习 VBA 比较单纯，得到的观念也会比较楚已经了解 VB 的程序员过渡到 VBA 需要相当时间的转变 (否则血统很难纯正)这一辑，我们将为您示范通过 VBA 做跨应用程序的操控 本视频或链接欢迎转载 <embed pluginspage=...
VBA示例
杨名天吓
07-29 671
VBA示例
Excel-VBA实用技巧范例-获取工作簿窗口的基本信息.zip
03-18
总的来说，这个压缩包文件提供了关于Excel-VBA编程的一个重要领域——获取和操作工作簿窗口信息的实例。通过深入研究这些范例，你可以掌握如何利用VBA定制Excel的用户界面，提高办公自动化水平，进一步提升工作效率...
Excel-VBA编程常用实例(150例) 完整版PDF.pdf
05-07
本书《Excel VBA编程入门范例》是一部专门为初学者及具有一定基础的用户设计的PDF文档，它包含了150个实际操作性强的VBA实例。这些实例覆盖了从基础到进阶的各种主题，例如应用程序对象、窗口、工作簿、工作表、...
Excel 2003高级VBA编程宝典--电子版及范例源码光盘
08-15
**Excel 2003高级VBA编程宝典——深入理解与实践** Excel 2003中的VBA（Visual Basic for Applications）是Microsoft Office套件中强大的编程工具，允许用户自定义工作簿、工作表和图表的行为，实现自动化处理和...
VBA实例代码
04-06
《Excel VBA从入门到实战》的代码和资源附录。由于VBA在语言特性方面并不完备，List 等常见数据结构以及相关算法依赖于使用者进行实现，并且惟一内置的 Dictionary 也需要另外进行引入，使得VBA 比之Python对于新手不甚友好。但是在Windows平台下，Excel的普及程度远远高于Python的运行环境。对于企业财务而言，作为普及率不输浏览器/js 组合的存在，Excel VBA由于其开箱即用的特性，在今后很长一段时间内，势必还会保持其旺盛的生命力。这就意味着，即使对于新手不友好，面对进阶的企业财务数据处理需求， VBA的编程技能仍不会被 Python或js替代。由于C系语言的共性，VBA语言本身的缺陷可以通过 借鉴其他编程语言/设计模式 来弥补。MVC，模板引擎，函数式编程... 这种 无意的"留白" 给了VBA程序员无限的创作空间。另外，在实践中总结与思考也必不可少，通过自动化项目归纳各项目之间内在的统一模式， 提炼与精减代码也是学习的重要一环。
VBA典型范例-入门材料
01-04
学习VBA入门材料，VBA典型范例-入门材料
ExcelVBA编程实例(150例)
10-06
ExcelVBA编程实例(150例)
Excel VBA编程入门范例
09-02
Excel VBA编程入门范例 Excel VBA编程入门范例 Excel VBA编程入门范例
工资管理系统-EXCEL VBA开发范例源码.zip
05-12
《工资管理系统——基于EXCEL VBA的开发实践详解》 在信息技术日新月异的今天，Excel VBA（Visual Basic for Applications）作为一种强大的自动化工具，被广泛应用于各种数据处理和管理场景，尤其是在企业内部的...
ExcelVBA编实战编程(很实用哦)[整理].pdf
10-11
Excel VBA编程是一种强大的工具，用于自动化Excel工作簿和工作表的任务。VBA（Visual Basic for Applications）是Microsoft Office套件内嵌的编程语言，它允许用户创建自定义功能、宏和子程序，以实现复杂的数据处理...
VBA 入门范例
cfqblue的博客
08-19 450
VBA 入门范例 教程
Excel VBA编程入门：16章实战范例指南
《ExcelVBA编程入门范例》是一本面向Excel VBA初学者和有一定基础的学习者的教程，旨在通过实践案例帮助读者掌握Excel VBA编程的基础知识和常用操作。该书由fanjy在ExcelHome博客提供，共分为16个章节，内容涵盖了...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值