excel中按多列进行匹配并对数量进行累加

公司的生产计划是按订单下发,但不同订单的不同产品中可能有用到相同的配件,按单1对1时,对计算机十分友好,但对于在配件库检料的工人来说就比较麻烦,上百条产品里可能会有多条都是相同的产品,首先考虑的办法是把数据进行了排序,让相同代号、材质、名称的数据挨在一起,但这样也并不是最优的,然后考虑的办法是把所有代号+材质+名称+领料人相同的数据的请领数量累加到一起,使其只有一条。下面是生产系统导出到excel中的数据,其中黄色底纹的就是相同数据:

代码就不细说了,做个流程图出来:

下面是代码,由于vba不能像javascript那样处理JSON数据,所以在用数组处理时比较麻烦:

vbscript 复制代码
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
相关推荐
躲在云朵里`2 分钟前
Spring Scheduler定时任务实战:从零掌握任务调度
java·数据库·mybatis
Java中文社群15 分钟前
炸裂:SpringAI新版发布,终于支持断线重连了!
java·后端·ai编程
cngkqy15 分钟前
excel中筛选条件,数字筛选和文本筛选相互转换
excel
Hello 0 117 分钟前
用计算思维“破解”复杂Excel考勤表的自动化之旅
自动化·excel·ai编程·计算思维
秃顶老男孩.27 分钟前
异步处理(前端面试)
前端·面试·职场和发展
哈喽姥爷35 分钟前
Spring Boot--Bean的扫描和注册
java·spring boot·后端·bean的扫描和注册
problc36 分钟前
Spring Boot `@Service` 互相调用全攻略:`@Autowired` vs `@Resource`
java·spring boot·后端
三脚猫的喵43 分钟前
微信小程序中实现AI对话、生成3D图像并使用xr-frame演示
前端·javascript·ai作画·微信小程序
文心快码BaiduComate1 小时前
文心快码3.5S全新升级,体验多智能体协同开发,最高赢无人机!
前端·后端·程序员
安卓开发者1 小时前
鸿蒙Next ArkWeb进程解析:多进程架构如何提升Web体验
前端·架构·harmonyos