Excel VBA案例办公用品采购计划分配表/办公耗材采购明细表

内容提要

大家好，我是冷水泡茶，本日在EXCELHOME论坛上看到一个乞助贴：用VBA做分配表。

下了附件一看，是把字符串里面的单位名称与数量，提取到一张矩阵表里，他的原始数据是这样的，购置操持表：

哀求结果是这样的，分配表：

正如他在贴子里所说“看着是一件很小的事情，但是做起来真的头大。
“

好在我们有VBA，通过一段代码，再也不用烦了，分享给大家：

基本思路：

1、把原始数据读入数组arr()。

2、对第6列数据字段进行处理，把分隔符合统一更换成“|”，得到一个字符串"深圳|2|惠州|2"，然后再分列，存到数组。

3、把目标数据读入数组arrResult()，循环两个数组，匹配对应记录，再把arr数组的i行，第6列数据装入一个数组arrItem，循环arrItem，把相应的记录填入数组arrResult。

4、把arrResult回写到目标事情表：分配表。

VBA代码

1、在模块1里，Assignment过程：

Sub Assignment() ' '作者：冷水泡茶，微信公众年夜众号：Excel活学活用 ' Dim wsSource As Worksheet Dim wsTarget As Worksheet Dim lastRow As Integer, lastCol As Integer Dim arr(), arrItem() As String, arrStr(), arrResult() Application.ScreenUpdating = False Set wsSource = ThisWorkbook.Sheets("购置操持表") Set wsTarget = ThisWorkbook.Sheets("分配表") With wsSource .Activate lastRow = .UsedRange.Rows.Count lastCol = .UsedRange.Columns.Count arr = .Range(Cells(4, 1), Cells(lastRow, lastCol)).Value arrStr = Array("", ",", "、", "，") For i = 1 To UBound(arr) For j = LBound(arrStr) To UBound(arrStr) arr(i, 6) = Replace(arr(i, 6), arrStr(j), "|") Next arr(i, 6) = Split(arr(i, 6), "|") Next End With With wsTarget .Activate lastRow = .UsedRange.Rows.Count lastCol = .UsedRange.Columns.Count .Range(Cells(4, 5), Cells(lastRow, lastCol)).ClearContents arrResult = .Range(Cells(3, 1), Cells(lastRow, lastCol)).Value For i = 1 To UBound(arr) For j = 2 To UBound(arrResult) Total = 0 If arrResult(j, 2) & arrResult(j, 3) = arr(i, 2) & arr(i, 3) Then arrItem = arr(i, 6) For m = LBound(arrItem) To UBound(arrItem) If m Mod 2 = 0 Then arrResult(j, Pxy(arrResult, arrItem(m), 2)) = arrItem(m + 1) Total = Total + CInt(arrItem(m + 1)) End If Next arrResult(j, 5) = Total End If Next Next .Range("A3").Resize(UBound(arrResult), UBound(arrResult, 2)) = arrResult End With MsgBox "Done!" Application.ScreenUpdating = TrueEnd Sub

代码解析：

（1）Line5~8，定义一批变量，数组、事情表工具等。

（2）line16，把原始数据装入数组arr。

（3）line17，设置一个数组arrStr，写入几个标点符号，这是在原始数据中用来分隔项目的字符。

（4）line18~23，把arr数组的第6列，分隔符号都更换成“|”，分列后再存到第6列，就把第6列变成一个类似“"深圳"，"2"，"惠州"，"2"“这样的一个数组。

（5）line30，把目标数据装入数组arrResult。

（6）line31~45，把处理过的数据写入arrResult。

（A）line35，把arr数组的第6列装入数组arrItem。

（B）line36~41，循环arrItem，利用自定义函数Pxy，把arrItem中单位名称的下一个元素，也便是数量，填入数组arrResutl中对应单位名称的位置。

（C）line42，写入合计数。

（7）line46，把arrResult数据写入事情表。

2、在模块1里，Pxy自定义函数：

Function Pxy(arr(), FieldName As String, Optional arrType As Integer = 0) Dim k$, t$ k = 0 t = 0 Select Case arrType Case Is = 0 For i = LBound(arr) To UBound(arr) k = k + 1 If arr(i) = FieldName Then t = 1 Exit For End If Next Case Is = 1 For i = LBound(arr, 1) To UBound(arr, 1) k = k + 1 If arr(i, 1) = FieldName Then t = 1 Exit For End If Next Case Is = 2 For i = LBound(arr, 2) To UBound(arr, 2) k = k + 1 If arr(1, i) = FieldName Then t = 1 Exit For End If Next End Select If t = 1 Then Pxy = k Else Pxy = 0 End IfEnd Function

代码解析：数组字段定位

（1）Line6~13，函数参数0，表示一维数组。

（2）line14~21，函数参数1，表示二维数组，查找定位首列字段，按行定位。

（3）line22~29，函数参数2，表示二维数组，查找定位首行字段，按列定位。

动画演示

总结

1、在实际事情中，我以为我们只要做“分配表”就可以了，在各个单位名称下面填写操持采购数量，在“合计”进行汇总，按合计数量采购，再按这张分配表分配就可以了。

2、对付提取“单位名称”、“数量”还可以用正则表达式。

3、对付分配表的表头，也便是单位名称，也可以根据原始数据天生，这里已经写好了，那就没有必要“多此一举”啦。

~~~~~~End~~~~~~

喜好就点个赞、点在看、留言评论、分享一下呗！
感谢支持！