【记录】用Excel 2013 VBA实现根据高度自动计算容积

【背景】

手上一个excel文件，需要写VBA去实现一个自动根据输入的高度算出对应的容积的功能。

【折腾过程】

1.之前虽然已经会Excel VBA，但是是之前老版本的Excel，现在本地安装的是新的Excel 2013，所以需要搞清楚新版本中如何使用VBA。

搜：

excel 2013 vba

参考：

Where Is the Visual Basic Editor in Excel 2013? – For Dummies

在打开Excel 2013的前提下：

去按：

Alt+F11

果然是可以直接调出

Microsoft Visual Basic For Applications

的：

然后就是去继续折腾：

添加一个按钮，然后添加VBA代码了。

2.添加按钮：

自己可以在VBA工程中，添加对应的按钮：

但是却不知道如何将这个按钮加入到Excel文件里面，以便用户可以直接点击，然后运行对应代码。

3.然后是也找到官网教程：

Excel 2013

但是还是不会把上面那个按钮插入到excel中，让其显示。

搜：

excel 2013 vba 插入按钮

参考：

excel中用vba加载宏添加菜单和按钮 – chongcilingjian的专栏 – 博客频道 – CSDN.NET

但是不是可以拖动添加的那种。

4.参考：

Excel 怎么在 excel 的单元格中，插入 button 控件啊？-ExcelVBA程序开发-ExcelHome技术论坛

去找找设计模式。

后来找到了：

但是点击后，没有任何作用。

5.另外参考：

怎样在Excel中插入单选按钮？

去尝试添加出来VBA的工具栏：

右击工具栏->自定义快速访问工具栏

自定义功能区->选中：开发工具

然后就可以看到工具栏中出现“开发工具”了。

然后点击开发工具->插入->表单控件中选择第一个那个白色的：按钮

然后鼠标可以拖动，然后拖动画出一个按钮：

然后右击按钮->指定宏：

选择此处的：

按钮2_Click

接下来就可以继续去编辑VBA代码了：

6.接下来就是：

参考自己之前的：

【整理】Excel VBA学习记录

去写代码。

然后先去试试VBA工作是否正常，代码写为：

Sub 按钮2_Click()
MsgBox "VBA work now !"
End Sub

效果是：

点击该按钮后，可以弹出对话框：

7.接着继续写代码。

中间参考了很多内容，比如：

一些参考资料：

VBA For Microsoft Excel

Excel VBA Tutorial – Easy Excel Macros

也出现很多错误，然后一点点解决掉了。

最终的Excel VBA代码为：

'define multiple return value type
Public Type WithinRange
    heightFrom As Integer
    heightTo As Integer
    capacityFrom As Integer
    capacityTo As Integer
End Type
Sub 按钮2_Click()
Dim curInputHeight As Integer
curInputHeight = Range("B3")
' check current input is valid or not
If curInputHeight = 0 Then
    MsgBox "当前B3为空，请输入正确的高度"
    Exit Sub
End If
Dim curChooseType As String
curChooseType = Range("B2").Text
'MsgBox "Range(""B2"").Text=" + curChooseType
'check current selected type valid or not
If curChooseType = "" Then
    MsgBox "当前B2选择为空，请选择正确的类型：汽油或柴油"
    Exit Sub
End If
Dim validRange As WithinRange
Dim targetSheet As Worksheet
If curChooseType = "汽油" Then
    'targetSheet = Sheet2
    '未设置对象变量或 With 块变量
    '取得当前Sheet | Excel VBA
    'http://excel.walk-nie.com/vba-basic-op/vba-basic-op-worksheet/254
    'Set targetSheet = Sheet2
    Set targetSheet = Workbooks(1).Worksheets("汽油")
ElseIf curChooseType = "柴油" Then
    'Set targetSheet = Workbooks(1).Worksheets.Item(3)
    Set targetSheet = Workbooks(1).Worksheets.Item("柴油")
Else
    MsgBox "当前B2选择类型无法识别。请选择正确的类型：汽油或柴油"
    Exit Sub
End If
validRange = findFitHeightCapacityRange(curInputHeight, targetSheet)
'validRange = findFitHeightCapacityRange(Workbooks.Item(1).Sheets.Item("柴油"))
'MsgBox validRange
'calc real capacity
Dim calculatedCapacity As Integer
calculatedCapacity = (validRange.capacityTo - validRange.capacityFrom) / (validRange.heightTo - validRange.heightFrom) * (curInputHeight - validRange.heightFrom) + validRange.capacityFrom
MsgBox "计算出来的最终容积=" & calculatedCapacity
End Sub
' found fit height and capacity range
Private Function findFitHeightCapacityRange(curInputHeight As Integer, targetSheet As Worksheet) As WithinRange
    Dim validRange As WithinRange
    Dim heightArr(9) As Integer
    Dim capacityArr(9) As Integer
    Dim heightCells As Range
    Dim capacityCells As Range
    Set heightCells = targetSheet.Range("A2:A10").Cells
    Set capacityCells = targetSheet.Range("B2:B10").Cells
    
    For i = 1 To 9
        heightArr(i - 1) = CInt(heightCells(i).Value)
        capacityArr(i - 1) = CInt(capacityCells(i).Value)
        'MsgBox heightArr(i - 1)
    Next i
    
    For i = 0 To 8
        If heightArr(i) >= curInputHeight & curInputHeight <= heightArr(i + 1) Then
            With validRange ' retrieve values here
                .heightFrom = heightArr(i)
                .heightTo = heightArr(i + 1)
                .capacityFrom = capacityArr(i)
                .capacityTo = capacityArr(i + 1)
            End With
            Exit For
        End If
        
    Next i
    ' return a single struct, vb6/vba-style
    findFitHeightCapacityRange = validRange
End Function

运行后的效果是：

（1）可以校验B2输入是否为空

（2）也会校验B3输入是否为空

（3）当选择汽油时计算出对应的容积

（4）当选择柴油时计算出对应的容积

【总结】

（1）未设置对象变量或 With 块变量

对于设置变量的时候，此处发现当变量类型是：

Worksheet

Range

等类型的时候，直接赋值会出现上述错误

解决办法是：

前面加个Set，变成：

1 2	`Dim` `targetSheet` `As` `Worksheet` `Set` `targetSheet = Workbooks(1).Worksheets("汽油")`

以及：

1 2	`Dim` `heightCells` `As` `Range` `Set` `heightCells = targetSheet.Range("A2:A10").Cells`

即可。

（2）（当出错时）退出当前函数（Sub，Function等）

直接使用Exit xxx即可，比如：

If curInputHeight = 0 Then
    MsgBox "当前B3为空，请输入正确的高度"
    Exit Sub
End If

（3）自定义变量类型（类似于结构体数组）

'define multiple return value type
Public Type WithinRange
    heightFrom As Integer
    heightTo As Integer
    capacityFrom As Integer
    capacityTo As Integer
End Type
 
Dim validRange As WithinRange

（4）选择（获得）一个sheet（或workbook）有多种写法

即支持直接传入index，也支持用sheet的名字：

Set targetSheet = Workbooks(1).Worksheets("汽油")
Set targetSheet = Workbooks(1).Worksheets(2)
Set targetSheet = Workbooks(1).Worksheets.Item(2)
Set targetSheet = Workbooks(1).Worksheets.Item("柴油")

（5）函数带返回值

Public Type WithinRange
    heightFrom As Integer
    heightTo As Integer
    capacityFrom As Integer
    capacityTo As Integer
End Type
 
Dim curInputHeight As Integer
Dim targetSheet As Worksheet
 
'调用函数的写法
validRange = findFitHeightCapacityRange(curInputHeight, targetSheet)
 
Private Function findFitHeightCapacityRange(curInputHeight As Integer, targetSheet As Worksheet) As WithinRange
    Dim validRange As WithinRange
 
    ......
     
    ' return a single struct, vb6/vba-style
    '返回值的写法：函数名 = 返回值
    findFitHeightCapacityRange = validRange
End Function

（6）用MsgBox打印内容：字符串，整型数值

Dim curChooseType As String
MsgBox "当前选择类型" + curChooseType
 
Dim calculatedCapacity As Integer
MsgBox "计算出来的最终容积=" & calculatedCapacity

（7）cell单元格的值，转换为int

用CInt即可：

Dim heightArr(9) As Integer
Dim heightCells As Range
Set heightCells = targetSheet.Range("A2:A10").Cells
 
heightArr(0) = CInt(heightCells(0).Value)

（8）for循环break退出

用Exit For：

For i = 0 To 8
    If xxx Then
        Exit For
    End If
Next i

【记录】用Excel 2013 VBA实现根据高度自动计算容积

与本文相关的文章

Hi，您需要填写昵称和邮箱！

网友最新评论 (1)

与本文相关的文章

Hi，您需要填写昵称和邮箱！

网友最新评论 (1)

订阅在路上