求助，好心大神帮帮忙吧，红包酬谢。

liu920228

没接触过VBA 找了一位大神的边学边改，到后面要自己写实在不会了，资料全在压缩包里，要求在那个word里。写完达到要求，微信10432117我定会酬谢。很感谢论坛的无私分享，我做完也会发到论坛里，让需要用的人下载，或者让大神们改的更完善。

liu920228

附件在这里

lsc900707

作个记号，晚些时间看看。。。。。。

liu920228

lsc900707 发表于 2016-10-28 10:23
作个记号，晚些时间看看。。。。。。

非常感谢。。

liu920228

自己小顶！d=====(￣▽￣*)b一下

hzruziniu

Sub 库存汇总2()
    ActiveSheet.Unprotect
    Dim arr, brr(), i&, j&, r&, aa, bb
    Dim d, k, t, x
    Set d = CreateObject("Scripting.Dictionary")
    Sheet3.Activate
    arr = [a1].CurrentRegion
    For i = 3 To UBound(arr)
        x = arr(i, 3) & "," & arr(i, 4)
        d(x) = d(x) & i & ","
    Next
    k = d.keys: t = d.items
    ReDim brr(1 To d.Count, 1 To 9)
    For i = 0 To UBound(k)
        bb = Split(k(i), ",")
        t(i) = Left(t(i), Len(t(i)) - 1)
        If InStr(t(i), ",") Then
            aa = Split(t(i), ",")
            brr(i + 1, 1) = arr(aa(0), 1): brr(i + 1, 2) = arr(aa(0), 2): brr(i + 1, 5) = arr(aa(0), 5): brr(i + 1, 6) = arr(aa(0), 6)
            brr(i + 1, 3) = bb(0): brr(i + 1, 4) = bb(1) ': Brr(i + 1, 8) = bb(2)
            For j = 0 To UBound(aa)
                brr(i + 1, 7) = brr(i + 1, 7) + arr(aa(j), 7)
                brr(i + 1, 9) = brr(i + 1, 9) + arr(aa(j), 9)
            Next
        Else
            brr(i + 1, 1) = arr(t(i), 1): brr(i + 1, 2) = arr(t(i), 2): brr(i + 1, 5) = arr(t(i), 5): brr(i + 1, 6) = arr(t(i), 6)
            brr(i + 1, 3) = bb(0): brr(i + 1, 4) = bb(1) ': Brr(i + 1, 8) = bb(2)
            brr(i + 1, 7) = arr(t(i), 7)
            brr(i + 1, 9) = arr(t(i), 9)
        End If
    Next
    Sheet7.Activate
    [a3:i5000].ClearContents                                   '清除内容
    [a3:i5000].Borders.LineStyle = xlNone                      '删除边框 线'
    [a3].Resize(UBound(brr), 9) = brr                          'brr赋值
    r = Range("a65536").End(3).Row
    For i = 3 To r
        If Range("i" & i) <> 0 And Range("g" & i) <> 0 Then
            Range("h" & i).Value = Range("i" & i).Value / Range("g" & i).Value  '单价列计算
        End If
    Next
    '==============================按升序排序,先排C列再排D列
    Sheet7.Range("a3:i" & r).Select
    With Sheet7.Sort
        .SortFields.Add Key:=Range("C2:C" & r), _
         SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("D3:D" & r), _
         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A3:I" & r)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With Range("a3:i" & r) '
        .Borders.LineStyle = xlContinuous           '添加边框线
        .BorderAround xlContinuous, xlMedium        '外边框加粗
    End With
    For i = r To 3 Step -1
        If Cells(i, 7) = 0 Then Rows(i).Delete      '删除0值行
    Next
End Sub

hzruziniu

山西浩宇库存管理（改二版）.rar (121.59 KB, 下载次数: 11)

2016-10-28 17:39 上传

点击文件名下载附件

hzruziniu

提出几点建议：
1、你设置存货明细帐的构思和方法不对路，不能便捷地根据EXCEL的原理进行查找和汇集。
2、从EXCEL的原理设置，应按以下顺序和方法进行设置：
  （1）平时业务专设一张出库、入库的工作表，同手工一样逐张开具录入。
  （2）根据出入库单把逐项信息保存到数据库，这张表是所有数据的集合。最好是出库入库在同一数据库内，否则统计查询较麻烦。
  （3）设置各种查询表：可设置明细帐打印帐页；月度收付存汇总表等等，只要有一张数据库的表，所有各种要求的查询表就非常方便地可以用代码进行设置。
  

LMY123

字典多条件多列分类汇总,d(x) = d(x) & i & ","