记录一个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把数据粘贴过来后就出现了这个现象;

排查过程

  1. 找了个office2010环境,直接复制粘贴发现并不会复现,但是我选中序号以后的列选择清楚内容后能稳定复现。 –确定问题确实存在,且是操作问题导致在这里插入图片描述
  2. 找了office2013和office2016版本验证,均能稳定复现。 –确定不是office版本问题
  3. 根据问题现象能断定肯定是在给下拉赋值时候赋值多了列。但代码逻辑是只有选中人名的列,判断逻辑如下:
    在这里插入图片描述
    难道我选中多个单元格,只要包含人名列,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的设计思路类似。
    在这里插入图片描述

写在最后

一般只要发现了问题的根本原因,解决起来都不会很难。因此怎么找到问题的原因就显得很重要也很关键。总结此问题没有快速解决的原因

  1. 通过VB开发excel的流程不熟悉,很多时间花在了熟悉开发流程上
  2. 没接触过VB语言,每加一句代码都需要百度
    虽然有种种理由,但感觉自己的思路是比较清晰的,咱们能做的就是一方面不断锻炼自己的开发思路,另一方面也要不断突破自己的技术范畴,千万不要一开始就具备抵触心理。
    加油吧骚年们,只要问题存在,你就一定有办法解决,别放弃哦!
  • 1
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

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

抵扣说明:

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

余额充值