VBA数组与字典解决方案第46讲：进行数据的模糊分类汇总 / 开普饭

大家好，今日我们继续讲解数组与字典解决方案，今日讲解的是第46讲：利用字典和数组，进行数据的模糊分类汇总。在VBA中,字典是引用的对象,那么我们可否能建立一个对象的数组呢?可以的.我们今日就来利用这个知识点,来完成一个数据的模糊分类汇总.也就是说我们要根据事先分好的类别,在源数据中找到类似数据,然后将这些数据进行汇总.

实例,我们看下面的数据:

A列和B列最为数据源,在数据源中分别找到型号中类似于W,H,K的数据,分别填到后面相应的数据列中.看起来复杂,但只要逻辑关系理顺好,一样可以顺利的完成,我们看下面我给出的代码:

Sub mynzsz_46() '第46讲利用字典和数组，进行数据的分类模糊汇总

Dim myDic(3)

Sheets('46').Select

'定义三个字典用来装要分类的三种数据

Set myDic(1) = CreateObject('Scripting.Dictionary')

Set myDic(2) = CreateObject('Scripting.Dictionary')

Set myDic(3) = CreateObject('Scripting.Dictionary')

'一次性装入源数据

myarr = Range('a2:b' & Range('a2').End(4).Row)

Range('d2:k' & Range('a2').End(4).Row).ClearContents

'将条件装入数组

mybrr = Array('W', 'H', 'T')

'分类汇总

For i = 1 To UBound(mybrr) + 1

For x = 1 To UBound(myarr)

If InStr(myarr(x, 1), mybrr(i - 1)) > 0 Then

myDic(i)(myarr(x, 1)) = myDic(i)(myarr(x, 1)) + myarr(x, 2)

End If

'回填数据

mycrr = Array(myDic(1).keys, myDic(1).items)

Range('d2').Resize(myDic(1).Count, 2) = Application.Transpose(mycrr)

mycrr = Array(myDic(2).keys, myDic(2).items)

Range('g2').Resize(myDic(2).Count, 2) = Application.Transpose(mycrr)

mycrr = Array(myDic(3).keys, myDic(3).items)

Range('j2').Resize(myDic(3).Count, 2) = Application.Transpose(mycrr)

'释放字典内存

Set myDic(1) = Nothing

Set myDic(2) = Nothing

Set myDic(3) = Nothing

End Sub

代码截图:

代码讲解:

1 上述过程中实现了将源数据的模糊分类汇总,最后将数据回填到结果区域.

2 '定义三个字典用来装要分类的三种数据

Set myDic(1) = CreateObject('Scripting.Dictionary')

Set myDic(2) = CreateObject('Scripting.Dictionary')

Set myDic(3) = CreateObject('Scripting.Dictionary')

上述代码中我定义了三个字典,这三个字典的名称是一个数组,这样处理的好处可以在我后面的代码中体现,用一次循环就可以完成需求.

3 '一次性装入源数据

myarr = Range('a2:b' & Range('a2').End(4).Row)

Range('d2:k' & Range('a2').End(4).Row).ClearContents

上述代码将源数据装入了数组,并清空了待填的数据区域.

4 '将条件装入数组

mybrr = Array('W', 'H', 'T')

用一个数组来装要分类的条件

5 '分类汇总

For i = 1 To UBound(mybrr) + 1

For x = 1 To UBound(myarr)

If InStr(myarr(x, 1), mybrr(i - 1)) > 0 Then

myDic(i)(myarr(x, 1)) = myDic(i)(myarr(x, 1)) + myarr(x, 2)

End If

这里大家注意一下,代码中应用了一个嵌套循环来完成目的,内层循环实现了数据汇总,外层循环实现了数据分类,分类标准是在源数据中是否有条件的字符存在.INSTR是判断的函数。

6 回填数据

mycrr = Array(myDic(1).keys, myDic(1).items)

Range('d2').Resize(myDic(1).Count, 2) = Application.Transpose(mycrr)

mycrr = Array(myDic(2).keys, myDic(2).items)

Range('g2').Resize(myDic(2).Count, 2) = Application.Transpose(mycrr)

mycrr = Array(myDic(3).keys, myDic(3).items)

Range('j2').Resize(myDic(3).Count, 2) = Application.Transpose(mycrr)

上述代码进行了数据的回填,这里大家要注意我先把keys, items要先装入一个数组,然后再转置回填.大家留意代码的写法,如果你没有确切的把握,类似问题要按照给出代码进行.虽然数组操作比SQL简单些,但也要尽可能的去复制和修正代码,而不是自己另辟蹊径.

7释放字典内存

Set myDic(1) = Nothing

Set myDic(2) = Nothing

Set myDic(3) = Nothing

上述代码将字典占用内存释放.

先看代码运行结果:

今日内容回向:

1 如何实现利用字典和数组进行数据的模糊分类汇总?

2 在回填数据时,如果我直接利用Range('d2').Resize(myDic(1).Count, 2) = Application.Transpose(myDic(1).keys, myDic(1).items) 是否可以?

VBA数组与字典解决方案第46讲：进行数据的模糊分类汇总

相关推荐