VBA——通过数组实现批量查询

阿塔克希

觉今是而昨非

前言

之前写的一个在excel表里面提取关键字所在行的小程序，是基于单元格操作的，所以提取一个关键词还行。如果要实现批量提取，数量一上来估计能直接把机器卡死。所以意识到了这一点，这次批量查询的项目我就通过数组进行操作。数组之所以会快很多，是因为类似于pandas之类的数据处理方式，先将数据读入内存，再进行操作，B站有人测试过，VBA和pandas的速度基本相差无几。

以下是上次通过find方法写的关键词查找

阿塔克希：VBA案例——批量导出查找结果

需求描述

有如图所示的两张数据表

第一张表详细罗列了每个集团的子公司,而第二张表格则是所有集团的一个清单。

我现在要做的就是在第三个Sheet上批量填入我需要的集团，之后在第四个Sheet上罗列出这些集团的所有子公司。

问题分析

对于这个问题，按照我之前的思路，无非就是进行循环遍历，判断然后copy一整行到sheet4。

但是这样的问题就是太慢了，实在太慢了！

表1的企业加起来有几万行,考虑到批量查找的企业最大数有几万的情况,就算没有卡死,那么使用者体验想必也是极差。

如果把老板的电脑整死机了，那么别说升职加薪了，直接卷铺盖走人也不是没有可能。

基于这一点，数组的使用十分必要。

所以参考了B站孙兴华老师的视频，通过数组完成了这一需求

https://www. bilibili.com/video/BV1r t4y1a72y?p=70&vd_source=e3f992cc84134cc8bcd4aef58d20f38c

具体视频如上。

思路分析

既然要写数组，那么当然是纯数组，即通过数组读取数据并且通过数组写入数据。

判断筛选的过程在数组中完成。

所以整体可分为四步：

1.将Sheet1的数据读入数组、将待查询的集团名称读入数组

2.在数组内部进行遍历判断

3.将结果输出

4.将以上过程封装及美化

具体过程

1.数据读入数组

数组一般有三种创建方法，分别是1.array、2.split、3.range

第一种创建方法我从来没用过，一般都是第二种和第三种，而本次要用到的就是第三种

分别给4张Sheet命名为

企业汇总、集团汇总、输入集团名称、查询结果

    Sheets("企业汇总").Range("A1").EntireRow.Copy Sheets("查询结果").Range("A1").EntireRow
    查询的企业行数 = Sheets("输入集团名称").Range("A" & Rows.Count).End(xlUp).Row
    查询的企业数组 = Sheets("输入集团名称").Range("A2:A" & 查询的企业行数).Value

这个是待查询的集团名称，以下是第一张Sheet的全部内容读入数组

    企业汇总行数 = Sheets("企业汇总").Range("A" & Rows.Count).End(xlUp).Row
    企业汇总数组 = Sheets("企业汇总").Range("A1").CurrentRegion.Value
    res = Sheets("企业汇总").Range("A1").CurrentRegion.Value

这里有一个点需要注意，即

res = Sheets("企业汇总").Range("A1").CurrentRegion.Value

目前进行到这里,res与企业汇总数组的大小与内容是 完全相同 的。

这是因为最后要输出到sheet4的是第一个Sheet中的部分数据，所以可以视为sheet1的子集，拥有其一部分的行数。通过这样的方法就免去了手动定义数组大小。

2.数组内部进行遍历判断

    For i = 1 To 查询的企业行数 - 1
        For j = 2 To 企业汇总行数
            If 企业汇总数组(j, 2) = 查询的企业数组(i, 1) Then
                次数 = 次数 + 1
                For 列数 = 1 To UBound(企业汇总数组, 2)
                    res(次数, 列数) = 企业汇总数组(j, 列数)
            End If
    Next

这里稍微有一点复杂，一共套了3层for循环和一层if条件判断。

首先 第一个 for

For i = 1 To 查询的企业行数 - 1

遍历的是要查询的集团名称，即手动输入的部分，第三个Sheet

接下来是 第二个 for

For j = 2 To 企业汇总行数

遍历的是Sheet1中的所有集团子公司

第三个for遍历的是所有符合条件的子公司的所有列。

For 列数 = 1 To UBound(企业汇总数组, 2)

在层层循环包裹的深处，就是我们的赋值语句

res(次数, 列数) = 企业汇总数组(j, 列数)

3.将结果输出

Sheets("查询结果").Range("A2").Resize(次数, UBound(res, 2)) = res

这里值得注意的是resize的第一个参数是次数，而不是像后面一样使用的是UBound(res, 1)

这就和我们第一部分res的由来有关，在循环中，我们将res前面部分的数据进行了修改，但是后面没有遍历到的位置就和sheet1中的数据一模一样。如果使用

Sheets("查询结果").Range("A2").Resize(UBound(res, 1), UBound(res, 2)) = res

那么结果就是会输出相当多我们不需要的结果

4.美化封装

这部分就直接略过了，在sheet中插入两个按钮连接上宏就可以。

完整代码

Sub 集团查询()
    Sheets("企业汇总").Range("A1").EntireRow.Copy Sheets("查询结果").Range("A1").EntireRow
    查询的企业行数 = Sheets("输入集团名称").Range("A" & Rows.Count).End(xlUp).Row
    查询的企业数组 = Sheets("输入集团名称").Range("A2:A" & 查询的企业行数).Value
    '得通过 查询的企业数组(1,1)索引
    '将全部企业导入另一个数组
    企业汇总行数 = Sheets("企业汇总").Range("A" & Rows.Count).End(xlUp).Row
    企业汇总数组 = Sheets("企业汇总").Range("A1").CurrentRegion.Value
    res = Sheets("企业汇总").Range("A1").CurrentRegion.Value
    '企业汇总数组从2开始是企业
    For i = 1 To 查询的企业行数 - 1
        For j = 2 To 企业汇总行数
            If 企业汇总数组(j, 2) = 查询的企业数组(i, 1) Then
                次数 = 次数 + 1
                For 列数 = 1 To UBound(企业汇总数组, 2)
                    res(次数, 列数) = 企业汇总数组(j, 列数)
            End If