VBA智能化汇总类型，难度比较高，鲜花奉上！

约定的童话

要求：汇总入库表里面的信息到库存表里面：①根据入库表I列日期找出离当前所在日期最近的日期，锁定其对应行的B:F列区域内容（图1）
②把锁定的区域内容存进数组，然后与库存表进行对比（对比依据是编码跟品牌）：如果库存表已有编码跟品牌了，则直接把数量加上，如果没有，则添加一行，填入信息！

humanmagic

1. Sub Demo()
   
2. 
   
3.     Dim findArr(), arr(), sht1 As Worksheet, sht2 As Worksheet
   
4.     Set sht1 = Sheets("成品入库登记表")
   
5.     Set sht2 = Sheets("成品库存统计表")
   
6.     arr = sht1.Range("I4:I" & sht1.Range("I4").End(xlDown).Row)
   
7.     Dim i As Long, j As Long, maxDate
   
8.     maxDate = arr(1, 1)
   
9.     For i = LBound(arr) + 1 To UBound(arr)
   
10.         If maxDate < arr(i, 1) Then
    
11.             maxDate = arr(i, 1)
    
12.         End If
    
13.     Next i
    
14.     j = 1
    
15.     For i = LBound(arr) + 1 To UBound(arr)
    
16.         If maxDate = arr(i, 1) Then
    
17.             ReDim Preserve findArr(1 To j)
    
18.             findArr(j) = i + 3
    
19.             j = j + 1
    
20.         End If
    
21.     Next i
    
22.     Dim rng As Range, bl As Boolean, firstAddress As String
    
23.     For i = LBound(findArr) To UBound(findArr)
    
24.         Set rng = sht2.Range("B4:B" & sht2.Range("B4").End(xlDown).Row).Find(sht1.Cells(findArr(i), 2).Value, , , xlWhole)
    
25.         If rng Is Nothing Then
    
26.             With sht2.Range("B4").End(xlDown)
    
27.                 .Offset(1, -1).Value = .Offset(0, -1).Value + 1
    
28.                 .Offset(1, 0).Value = sht1.Cells(findArr(i), 2).Value
    
29.                 .Offset(1, 1).Value = sht1.Cells(findArr(i), 3).Value
    
30.                 .Offset(1, 2).Value = sht1.Cells(findArr(i), 4).Value
    
31.                 .Offset(1, 3).Value = sht1.Cells(findArr(i), 5).Value
    
32.                 .Offset(1, 4).Value = sht1.Cells(findArr(i), 6).Value
    
33.             End With
    
34.         Else
    
35.             firstAddress = rng.Address
    
36.             Do
    
37.                 If rng.Offset(0, 3).Value = sht1.Cells(findArr(i), 5).Value Then
    
38.                     rng.Offset(0, 4).Value = rng.Offset(0, 4).Value + sht1.Cells(findArr(i), 6).Value
    
39.                     bl = True
    
40.                     Exit Do
    
41.                 End If
    
42.                 Set rng = sht2.Range("B4:B" & sht2.Range("B4").End(xlDown).Row).FindNext(rng)
    
43.             Loop While Not rng Is Nothing And rng.Address <> firstAddress
    
44.         End If
    
45.         If Not bl Then
    
46.             With sht2.Range("B4").End(xlDown)
    
47.                 .Offset(1, -1).Value = .Offset(0, -1).Value + 1
    
48.                 .Offset(1, 0).Value = sht1.Cells(findArr(i), 2).Value
    
49.                 .Offset(1, 1).Value = sht1.Cells(findArr(i), 3).Value
    
50.                 .Offset(1, 2).Value = sht1.Cells(findArr(i), 4).Value
    
51.                 .Offset(1, 3).Value = sht1.Cells(findArr(i), 5).Value
    
52.                 .Offset(1, 4).Value = sht1.Cells(findArr(i), 6).Value
    
53.             End With
    
54.         End If
    
55.         bl = False
    
56.     Next i
    
57. 
    
58. End Sub

复制代码

约定的童话

humanmagic 发表于 2018-8-18 17:10

辛苦了，大神，等会验证下

约定的童话

humanmagic 发表于 2018-8-18 17:10

大神，你这是小号吧？这么难都拿下了，佩服佩服，实在是厉害！鲜花奉上！！！

约定的童话

humanmagic 发表于 2018-8-18 17:10

验证了，非常完美，其实里面有一个出库表，用你这个代码稍加修改，完美运行，再次感谢！！！

humanmagic

约定的童话 发表于 2018-8-18 19:26
大神，你这是小号吧？这么难都拿下了，佩服佩服，实在是厉害！鲜花奉上！！！

不是小号，不难，把你实际操作步奏按代码表达出来就可以了

约定的童话

humanmagic 发表于 2018-8-18 19:30
不是小号，不难，把你实际操作步奏按代码表达出来就可以了

大神，有个新情况，研究了半天没弄明白，就是把库存表清空后，入库表无法直接汇总过来，报400；我把B4改为B3后，汇总过来的是重复两行的数据，很是纠结！

ivccav

约定的童话 发表于 2018-8-21 15:18
大神，有个新情况，研究了半天没弄明白，就是把库存表清空后，入库表无法直接汇总过来，报400；我把B4改 ...

请查收附件：

123.zip (45.25 KB, 下载次数: 27)

2018-8-21 16:56 上传

点击文件名下载附件

jjmysjg

编号没有的，没有加入一行

humanmagic

约定的童话 发表于 2018-8-21 15:18
大神，有个新情况，研究了半天没弄明白，就是把库存表清空后，入库表无法直接汇总过来，报400；我把B4改 ...

这是因为你清空了之后，B4.End(XlDown)直接到了工作表最下面一行，后面的代码添加新行肯定报错。