多条件的高级筛选与汇总代码完善

雨香红叶

希望可以依据表中D列的生产部门筛选汇总出某个部门的生产计划，再依据物料编码进行汇总合并，最后再对应显示订单日期（以相同物料编码E列中订单日期K列中的最早日期）与订单号和汇总的数量（I列中相同物料编码的总和）然后生成到新的表中，——蓝色部分描述的代码已经实现，老师们也可以更改完善，没有关系的！如果有更好的代码，请老师赐教！我目前的代码是依据物料编码进行汇总筛选的，现在就是要多加一个条件，就是在此基础上加一个依据某部门，再进行汇总筛选，

lsc900707

先帮楼主顶下帖。。。。。。

雨香红叶

lsc900707 发表于 2017-4-1 10:11
先帮楼主顶下帖。。。。。。

老师，看到你，就激动！我有救了！上次为了时间汇总的事，把老师给气坏了，

雨香红叶

不能沉啊，希望老师可以协助

lsc900707

雨香红叶 发表于 2017-4-1 14:03
不能沉啊，希望老师可以协助

问题不难，但你要说明一下数据之间的对应关系（因为名称不一样）

雨香红叶

lsc900707 发表于 2017-4-1 17:10
问题不难，但你要说明一下数据之间的对应关系（因为名称不一样）

比如说那个数据？

雨香红叶

lsc900707 发表于 2017-4-1 17:10
问题不难，但你要说明一下数据之间的对应关系（因为名称不一样）

就是依照生产部门筛选汇总出有关一个部门的生产订单，

lsc900707

雨香红叶 发表于 2017-4-1 23:11
就是依照生产部门筛选汇总出有关一个部门的生产订单，

把销售订单明细表的第一列删除，两个计划一起生成：
Sub lsc()
  arr = Sheets("销售订单明细").UsedRange
  ReDim brr(1 To UBound(arr), 1 To 5)
  ReDim crr(1 To UBound(arr), 1 To 5)
  For i = 2 To UBound(arr)
      If arr(i, 3) Like "*装配*" Then
        m = m + 1
        brr(m, 1) = arr(i, 4): brr(m, 2) = arr(i, 1): brr(m, 3) = arr(i, 5): brr(m, 4) = arr(i, 9): brr(m, 5) = arr(i, 7)
      End If
      If arr(i, 3) Like "*仪器*" Then
         n = n + 1
        crr(n, 1) = arr(i, 4): crr(n, 2) = arr(i, 1): crr(n, 3) = arr(i, 5): crr(n, 4) = arr(i, 9): crr(n, 5) = arr(i, 7)
      End If
  Next
  Sheets("装配生产主计划").[b5].Resize(m, 5) = brr
  Sheets("仪器生产主计划").[b5].Resize(n, 5) = crr
End Sub

lsc900707

雨香红叶 发表于 2017-4-1 23:11
就是依照生产部门筛选汇总出有关一个部门的生产订单，

加一句清除数据的代码，以便更新：

1. Sub lsc()
   
2.   Sheets("装配生产主计划").UsedRange.Offset(5, 1).ClearContents
   
3.   Sheets("仪器生产主计划").UsedRange.Offset(5, 1).ClearContents
   
4.   arr = Sheets("销售订单明细").UsedRange
   
5.   ReDim brr(1 To UBound(arr), 1 To 5)
   
6.   ReDim crr(1 To UBound(arr), 1 To 5)
   
7.   For i = 2 To UBound(arr)
   
8.       If arr(i, 3) Like "*装配*" Then
   
9.         m = m + 1
   
10.         brr(m, 1) = arr(i, 4): brr(m, 2) = arr(i, 1): brr(m, 3) = arr(i, 5): brr(m, 4) = arr(i, 9): brr(m, 5) = arr(i, 7)
    
11.       End If
    
12.       If arr(i, 3) Like "*仪器*" Then
    
13.          n = n + 1
    
14.         crr(n, 1) = arr(i, 4): crr(n, 2) = arr(i, 1): crr(n, 3) = arr(i, 5): crr(n, 4) = arr(i, 9): crr(n, 5) = arr(i, 7)
    
15.       End If
    
16.   Next
    
17.   Sheets("装配生产主计划").[b5].Resize(m, 5) = brr
    
18.   Sheets("仪器生产主计划").[b5].Resize(n, 5) = crr
    
19. End Sub

复制代码

雨香红叶

lsc900707 发表于 2017-4-2 00:49
加一句清除数据的代码，以便更新：

发生了一个错误老师