公司的生产计划是按订单下发,但不同订单的不同产品中可能有用到相同的配件,按单1对1时,对计算机十分友好,但对于在配件库检料的工人来说就比较麻烦,上百条产品里可能会有多条都是相同的产品,首先考虑的办法是把数据进行了排序,让相同代号、材质、名称的数据挨在一起,但这样也并不是最优的,然后考虑的办法是把所有代号+材质+名称+领料人相同的数据的请领数量累加到一起,使其只有一条。下面是生产系统导出到excel中的数据,其中黄色底纹的就是相同数据:
代码就不细说了,做个流程图出来:
下面是代码,由于vba不能像javascript那样处理JSON数据,所以在用数组处理时比较麻烦:
Option Explicit
Private infos() As String
'汇总
Sub myTotal()
Dim totalRowNumber As Integer
Dim i As Integer
Dim j As Integer
Dim 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 totalRowNumber
id = 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 13
infos(arrCount, j) = Sheets(1).Cells(i, j)
Next
'数组条数+1
arrCount = arrCount + 1
End If
Next
'清除区域数据
Sheets(1).Range(totalRowNumber + 1 & ":65535").ClearContents
'输出数组到表格中
For i = 2 To UBound(infos)
'如果infos(i,1)没有内容,说明后面都是空的行,所以就结束函数了
If Len(infos(i, 1)) = 0 Then Exit Sub
For j = 1 To 13
Sheets(1).Cells(totalRowNumber + i, j) = infos(i, j)
Next
Next
End Sub
'判断数组是否存在
Private Function isExist(ByVal name As String) As Boolean
Dim i As Integer
Dim id As String
For i = 2 To UBound(infos)
id = infos(i, 5) & "|" & infos(i, 6) & "|" & infos(i, 7) & "|" & infos(i, 8)
If name = id Then
isExist = True
Exit Function
End If
Next
isExist = False
End Function
'数量累加
Private Sub addRequireNumber(ByVal name As String, ByVal requireNumber As Long, ByVal order As String)
Dim i As Integer
Dim id As String
Dim 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 Then
infos(i, 9) = Str(Int(infos(i, 9)) + Int(requireNumber))
'如果订单号中没有包含相同的字符才添加
If InStr(1, infos(i, 2), subOrder) = 0 Then
infos(i, 2) = infos(i, 2) & "/" & subOrder
End If
Exit Sub
End If
Next
End Sub