VBA常用技巧代码解析

xiamy

示例文件.part01.rar (1.91 MB)  下载错误
提示“附件文件不存在或无法读入，请与管理员联系。”

qiiqii

与楼上同问～～～～～～～
救急！

atom21

感谢分享，实在太好了。

请问示例文件附件1怎么无法下载？急！！！

yuanzhuping

原帖由 xiamy 于 2010-4-27 08:09 发表
示例文件.part01.rar (1.91 MB)  下载错误
提示“附件文件不存在或无法读入，请与管理员联系。”

已重新上传了，不知道为什么，示例文件.part01.rar 老是不好下载。

atom21

原帖由 yuanzhuping 于 2010-4-27 16:26 发表

已重新上传了，不知道为什么，示例文件.part01.rar 老是不好下载。

已经好了，谢谢！

autumnalRain

能否请老师也讲讲DICTIONARY的用法？最近学习数据字典，但总感觉自已有很多认识不透，希望得到老师指点！
可否请老师给下面的代码加上注释？！附件中内容
Sub 汇总()
    Dim Arr, nr%, c%, iK%, iA%, m%, n%, Gs$, nc%, xArr()
    Dim Ds As Object
    Set Ds = CreateObject("scripting.dictionary")
    [a2:e65536].ClearContents
    iA = 1
    For i = 2 To Sheets.Count
        With Sheets(i)
            nr = .Cells(.Rows.Count, "a").End(xlUp).Row
            nc = .Cells(1, .Columns.Count).End(xlToLeft).Column
            Arr = .Range(.Cells(2, 1), .Cells(nr, nc))
            On Error Resume Next
            For rr = 1 To UBound(Arr, 1)
                Gs = ""
                For c = LBound(Arr, 2) To UBound(Arr, 2) - 3
                    Gs = Gs & Arr(rr, c)
                Next c
                Ds.Add Gs, iA
                If Err.Number > 0 Then
                    iK = Ds(Gs)
                    xArr(iK, 3) = xArr(iK, 3) + Arr(rr, 3)
                    xArr(iK, 4) = xArr(iK, 4) + Arr(rr, 4)
                   Err.Clear
                Else
                    ReDim Preserve xArr(1 To nr, 1 To nc)
                    For c = LBound(Arr, 2) To UBound(Arr, 2)
                        xArr(iA, c) = Arr(rr, c)
                    Next c
                    iA = iA + 1
                End If
            Next rr
            On Error GoTo 0
        End With
    Next i
    Set Ds = Nothing
    Cells(2, 1).Resize(iA - 1, nc - 1).Value = xArr
   
    n = Cells(65536, 1).End(3).Row
    For m = 2 To n
        Cells(m, 5) = Application.Round(Cells(m, 4) / Cells(m, 3), 2)
    Next m
    Cells(n + 2, 2) = "合计"
    Cells(n + 2, 3) = Application.Sum(Range(Cells(2, 3), Cells(n, 3)))
    Cells(n + 2, 4) = Application.Sum(Range(Cells(2, 4), Cells(n, 4)))
End Sub

[ 本帖最后由 autumnalRain 于 2010-4-29 12:02 编辑 ]

hayaa

谢谢老师相当的好啊

Mississippi

好贴，慢慢品味。

gddn

十分 感谢，正在学习VBA，LZ的书帮助很大

xiaoyatoucugb

版主辛苦了，非常感谢