记录一个EXCEL中VBA开发的踩坑点
背景
近期参与开发一个互联网系统,系统的主要作用是采集指定人群的指定数据(公司的系统不方便透露,理解为数据采集系统就行),由于要支持大批量采集因此当时技术选型定在了使用excel,这样用户可以灵活安排自己的时间,提前按excel要求整理相关数据,要使用时上传就可以。
excel设计思路及结构
excel要采集的数据可以理解大致分为两类:人和数,因此excel分为两个页签来采集数据,两个页签按照一行一人,一行一条数据的方式来填写。
由于一条数据中可能关联多个人,因此“数页签”中某些列需要是下拉,且下拉的值需要从“人页签”取,如下:
由于下拉选项需要根据“人页签”变化并且还有其他筛选规则,因此选择了通过EXCEL的宏(即VBA代码)来实现。VB代码如下:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim dic As Object
Dim order
Dim arr As Variant
Dim i As Integer
Dim j As Integer
Dim di As Object
Dim k As Variant
Set dic = CreateObject("scripting.dictionary")
Set di = CreateObject("scripting.dictionary")
With Sheets("人")
arr = .Range("a4:z" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
If Target.Column = 2 Or Target.Column = 95 Or Target.Column = 113 Or Target.Column = 140 Then
order = "XX" & Cells(Target.Row, 1).Value
For i = 1 To UBound(arr)
If arr(i, 1) = order Then
If arr(i, 3) = "XX" Then
dic(arr(i, 4)) = ""
Else
If Target.Column = 2 Then
dic("") = ""
Else
dic(arr(i, 17)) = ""
End If
End If
Else
dic("") = ""
End If
Next i
If (UBound(dic.keys) = 0) And (Join(dic.keys, ",") = "") Then
Target.Validation.Delete
Else
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=Join(dic.keys, ",")
End With
End If
End If
End Sub
大致思路是:当“数页签”的任意单元格被选中时,判断当前被选中的单元格是否是下拉选人的单元格,如果是则从“人页签”读取对应的人名并给选中的单元格更新下拉选项值。
问题描述
看似天衣无缝的设计终究还是被用户发现了漏洞,用户告诉我现在他手上的excel中“数页签”所有列全部变成了下拉选人名,并且提供了如下信息:
- 使用的office版本为2010;
- 刚拿到的excel模板没有问题,由于他们的数据在类似的excel上,从另外的excel把数据粘贴过来后就出现了这个现象;
排查过程
- 找了个office2010环境,直接复制粘贴发现并不会复现,但是我选中序号以后的列选择清楚内容后能稳定复现。 –确定问题确实存在,且是操作问题导致
- 找了office2013和office2016版本验证,均能稳定复现。 –确定不是office版本问题
- 根据问题现象能断定肯定是在给下拉赋值时候赋值多了列。但代码逻辑是只有选中人名的列,判断逻辑如下:
难道我选中多个单元格,只要包含人名列,target.Column都能满足条件?于是我分别在选中单个单元格和选中多个单元格的情况下做了调试。结果如下
- 单个单元格选中
- 多个单元格选中
- 另外多个单元格
他喵的,这不破案了嘛
问题原因
这个target.Column在选中单个单元格时候,取值为选中的单元格所在的列号;当选中的是多个单元格时,取值为第一个单元格所在的列号。
因此当选择多个单元格且以人名列单元格开始时,满足代码中的判断条件并将选中的所有单元格都设置为下拉并赋值下拉选项。
解决方案
知道了问题的根源,解决起来就简单了,我采用的是比较简单粗暴的方案:只有在选择单个单元格的时候才赋值。找度娘问了下,最后采用Target.Address。以下是当选中单个单元格和多个单元格的情况下Target.Address的值。
-
选中单个单元格
-
选中多个单元格
**选中单个单元格Target.Address取值为单元格地址;选中多个单元格Target.Address取值为地址范围。**因此我在判断是否是人名列之前先判断了一下是否选中的是单个单元格
If Target.Address Like "*:*" = False Then
最终VB代码
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim dic As Object
Dim order
Dim arr As Variant
Dim i As Integer
Dim j As Integer
Dim di As Object
Dim k As Variant
Set dic = CreateObject("scripting.dictionary")
Set di = CreateObject("scripting.dictionary")
With Sheets("人")
arr = .Range("a4:z" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
If Target.Address Like "*:*" = False Then
If Target.Column = 2 Or Target.Column = 95 Or Target.Column = 113 Or Target.Column = 140 Then
order = "XX" & Cells(Target.Row, 1).Value
For i = 1 To UBound(arr)
If arr(i, 1) = order Then
If arr(i, 3) = "XX" Then
dic(arr(i, 4)) = ""
Else
If Target.Column = 2 Then
dic("") = ""
Else
dic(arr(i, 17)) = ""
End If
End If
Else
dic("") = ""
End If
Next i
If (UBound(dic.keys) = 0) And (Join(dic.keys, ",") = "") Then
Target.Validation.Delete
Else
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=Join(dic.keys, ",")
End With
End If
End If
End If
End Sub
补充
1.excel对VB的支持情况
- office自带支持VB代码的运行,所以office的安装包很大
- wps默认不支持VB,需要安装宏才能支持
2.VB开发excel的思路
- 按照excel的页签编写VB代码
- excel的宏附带了excel各个操作对应的函数,为excel编写代码其实就是找到合适的函数去追加VB代码,这个思路跟VUE中的created、mounted、unload的设计思路类似。
写在最后
一般只要发现了问题的根本原因,解决起来都不会很难。因此怎么找到问题的原因就显得很重要也很关键。总结此问题没有快速解决的原因
- 通过VB开发excel的流程不熟悉,很多时间花在了熟悉开发流程上
- 没接触过VB语言,每加一句代码都需要百度
虽然有种种理由,但感觉自己的思路是比较清晰的,咱们能做的就是一方面不断锻炼自己的开发思路,另一方面也要不断突破自己的技术范畴,千万不要一开始就具备抵触心理。
加油吧骚年们,只要问题存在,你就一定有办法解决,别放弃哦!