【Excel VBA】数组应用(5)

1.多表查询

在日常工作中，源数据经常分散在多个工作表中。例如，示例工作簿中有6个月的数据分别保存在不同的工作表中，如下图所示。

现需要将全部月份金额大于或等于2000的数据罗列出来，示例代码如下。

Sub TablesQuery()
     Dim wksList As Worksheet
     Dim avntList() As Variant, avntResults() As Variant
     Dim i As Integer, j As Integer
     For Each wksList In Worksheets'循环遍历所有工作表
    If wksList.Name <> "多表查询" Then'判断当前遍历的工作表名称是否为"多表查询"。
             avntList() = wksList.Range("a1").CurrentRegion.Value
             For i = 2 To UBound(avntList())
                 If avntList(i, 4) >= 2000 Then
                     j = j + 1
                     ReDim Preserve avntResults(1 To 4, 1 To j)
                     avntResults(1, j) = wksList.Name
                     avntResults(2, j) = avntList(i, 2)
                     avntResults(3, j) = avntList(i, 3)
                     avntResults(4, j) = avntList(i, 4)
                 End If
             Next i
         End If
     Next wksList
     Range("a2").Resize(j, 4) = WorksheetFunction.Transpose(avntResults())
 End Sub

第11行代码重新定义数组大小，由于ReDim Perserve只能修改数组的最后一维下标上界，所以需要将结果的列数作为第一维，结果的行数作为数组的第二维，以此重新定义数组。

第22行代码利用Transpose函数实现数组转置。

运行过程，结果如下图所示。

 

2.两列数据对比重复

示例文件中数据源如图1左半部分所示，所列不同的数据存在着重复数据。

如果需要提取两列数据中的重复项和唯一项，可以使用Filter函数，示例代码如下。运行结果如上图右半部分所示。​

Sub getSame()
     Dim avntData() As Variant, avntList() As Variant
     Dim astrResultsSame() As String, astrResultsDis() As String
     Dim avntTemp
     Dim intCountSame As Integer, intCountDis As Integer
     Dim intTemp As Integer
     avntData() = WorksheetFunction.Transpose(Range("a2:a13").Value)
     avntList() = WorksheetFunction.Transpose(Range("c2:c13").Value)
     For intTemp = 1 To UBound(avntData())
         avntTemp = Filter(avntList(), avntData(intTemp), True)
    If UBound(avntTemp) >= 0 Then'判断数组下标上界是否大于等于0
             intCountSame = intCountSame + 1
             ReDim Preserve astrResultsSame(1 To intCountSame)
             astrResultsSame(intCountSame) = avntData(intTemp)
         Else
             intCountDis = intCountDis + 1
             ReDim Preserve astrResultsDis(1 To intCountDis)
             astrResultsDis(intCountDis) = avntData(intTemp)
         End If
     Next intTemp
     Range("F2").Resize(intCountSame, 1) = _
         WorksheetFunction.Transpose(astrResultsSame())
     Range("G2").Resize(intCountDis, 1) = _
         WorksheetFunction.Transpose(astrResultsDis())
 End Sub

第10行代码将Filter筛选后的数据保存到数组中，利用Filter函数，可以筛选一个一维数组，并以数组形式返回筛选结果。

第12~14行代码将重复出现的数据保存到数组中。

第16~18行代码将不重复的数据保存到数组中。

第10行代码中，Filter函数可根据条件筛选出一维数组中包含指定字符串的数据，并返回一个下标上界大于等于0的新数组，若未筛选出包含字符串的数据，新数组的下标上界将为-1，其语法格式如下。

Filter(sourcearray,match,include,compare)

参数sourcearray是必需的，指定待筛选的一维数组。

参数match是必需的，其值指定待查询的字符串。

参数include是可选的，其值为Boolean类型，指定返回的数组是否包含字符串。值为True时返回包含字符串的子集；值为False时，返回不包含字符串的子集。

参数compare是可选的，指定使用字符串比较类型，通常用于区分大小写，不指定该参数时默认为0。

注：Filter函数只能筛选一维数组并且只能筛选出包含字符串的数据，若需要精确查找数组数据，可以组合使用工作表函数Index与Match。

 

---

微信公众号：VBA168

淘宝店铺地址：https://item.taobao.com/item.htm?spm=a1z10.1-c-s.w4004-21233576391.4.1af0683dzrx3oU&id=584940166162

关注微信公众号，每天及时接收Excel VBA经典示例讲解。

淘宝店铺提供Excel定制服务。

祝你工作和学习更轻松！