条条大道通罗马，VBA中数组实例练习！

VBA数组部分已经讲完了，前几天正好看到有群友提问的一道题目：

把左边的数据转化成右边的数据。

我们先来看下如何用VBA解决这个题目，思路如下：

1、把左边的数据读取到一个数组arr1中，arr1就是一个14行，6列的数组（

不包含标题行），arr1（1 to 14，1 to 6）

2、声明一个新的数组arr2，用来装想要的结果。我们知道，想要的结果只有3列，行数由姓名的个数决定，有多少个姓名就有多少行，所以对姓名区域非空单元格进行计数即可知道arr2应该有多少行，如果不想麻烦，也可以把arr2的行数写的大点，足够容下这些姓名即可，自己估计下就知道了。

3、arr2的第一个、第二个元素跟arr1中的第一列、第二列对应，第三个元素由arr1中的第三列到第六列中的元素决定。做两个循环，一个循环arr1的行数，一个循环每行的3到6列，把循环出来的值一个个写到arr2中去。

4、写入完成后对新的数据区域第一列和第二列的数据中单元格内容相同的数据进行合并。

具体代码如下：

Sub test()

Dim i%, n%, m%, h%, k%, arr1, arr2()

h = Application.CountA(Range('c2:f15'))

arr1 = Range('a2', [a2].End(xlDown)(1, 6))

ReDim arr2(1 To h, 1 To 3)

For i = 1 To UBound(arr1)

        For n = 3 To UBound(arr1, 2)

                If arr1(i, n) <> '' Then

                m = m 1

                arr2(m, 1) = arr1(i, 1)

                arr2(m, 2) = arr1(i, 2)

                arr2(m, 3) = arr1(i, n)

                End If

        Next

Next

[h1:j1] = Array('大区', '部门', '姓名')

[h2].Resize(h, 3) = arr2

Application.DisplayAlerts = False

For k = h 1 To 1 Step -1

If Cells(k, 8).Value = Cells(k 1, 8).Value Then

Cells(k, 8).Resize(2, 1).Merge

End If

If Cells(k, 9).Value = Cells(k 1, 9).Value Then

Cells(k, 9).Resize(2, 1).Merge

End If

Next

Application.DisplayAlerts = True

End Sub

效果如下：

以上这个例子，可以很好的练习数组部分讲的知识，大家可以对照练习下。

当然，条条大道通罗马，我们看下另外一种办法，也很快，而且都是很基础的操作。

1、先把数据整理下，把姓名整理到一列，整理用的是循环引用的技巧，很值得学习。

2、把公式去掉，多余的姓名列删除，进行筛选，把姓名为0的行删除掉（当然0值不删除，直接透视后在透视表中处理也可以）。

3、数据透视

简单的三步就可以达到你想要的效果。

今天的分享就到这里了！

视频教程正在陆续录制中，进入公众号后台菜单中可了解详情！