公司的生产计划是按订单下发，但不同订单的不同产品中可能有用到相同的配件，按单1对1时，对计算机十分友好，但对于在配件库检料的工人来说就比较麻烦，上百条产品里可能会有多条都是相同的产品，首先考虑的办法是把数据进行了排序，让相同代号、材质、名称的数据挨在一起，但这样也并不是最优的，然后考虑的办法是把所有代号+材质+名称+领料人相同的数据的请领数量累加到一起，使其只有一条。下面是生产系统导出到excel中的数据，其中黄色底纹的就是相同数据：
代码就不细说了，做个流程图出来：
下面是代码，由于vba不能像javascript那样处理JSON数据，所以在用数组处理时比较麻烦：
Option ExplicitPrivate infos() As String'汇总
Sub myTotal()Dim totalRowNumber As IntegerDim i As IntegerDim j As IntegerDim arrCount As Integer '数组数据位置Dim id As String'数组初始位置arrCount = 2'获得总行数totalRowNumber = Sheets(1).[a1].End(xlDown).Row'调整数组大小(考虑到避免多次调整数组大小，所以直接定义一个跟数据行一样多的数组)ReDim infos(2 To totalRowNumber, 1 To 13)For i = 2 To totalRowNumberid = Sheets(1).Cells(i, 5) & "|" & Sheets(1).Cells(i, 6) & "|" & Sheets(1).Cells(i, 7) & "|" & Sheets(1).Cells(i, 8)If isExist(id) Then'判断当前行是否已存在数组中，如果存在则请领数量累加addRequireNumber id, Sheets(1).Cells(i, 9), Sheets(1).Cells(i, 2)Else'如果不存在则加入到数组中For j = 1 To 13infos(arrCount, j) = Sheets(1).Cells(i, j)Next'数组条数+1arrCount = arrCount + 1End IfNext'清除区域数据Sheets(1).Range(totalRowNumber + 1 & ":65535").ClearContents'输出数组到表格中For i = 2 To UBound(infos)'如果infos(i,1)没有内容，说明后面都是空的行，所以就结束函数了If Len(infos(i, 1)) = 0 Then Exit SubFor j = 1 To 13Sheets(1).Cells(totalRowNumber + i, j) = infos(i, j)NextNext
End Sub'判断数组是否存在
Private Function isExist(ByVal name As String) As BooleanDim i As IntegerDim id As StringFor i = 2 To UBound(infos)id = infos(i, 5) & "|" & infos(i, 6) & "|" & infos(i, 7) & "|" & infos(i, 8)If name = id ThenisExist = TrueExit FunctionEnd IfNextisExist = False
End Function'数量累加
Private Sub addRequireNumber(ByVal name As String, ByVal requireNumber As Long, ByVal order As String)Dim i As IntegerDim id As StringDim subOrder As String'去掉订单的年号subOrder = Mid(order, InStr(1, order, "-") + 1, Len(order))For i = 2 To UBound(infos)id = infos(i, 5) & "|" & infos(i, 6) & "|" & infos(i, 7) & "|" & infos(i, 8)If name = id Theninfos(i, 9) = Str(Int(infos(i, 9)) + Int(requireNumber))'如果订单号中没有包含相同的字符才添加If InStr(1, infos(i, 2), subOrder) = 0 Theninfos(i, 2) = infos(i, 2) & "/" & subOrderEnd IfExit SubEnd IfNext
End Sub
