[已解决]这段程序什么意思求注释！解释怎么用

CEL_hjl

<FONT style="BACKGROUND-COLOR: #f7f7f7">Option Explicit
Sub 整理数据()
    Dim sh As Worksheet, arr, k%, d, m%, crr, drr
    On Error Resume Next
    arr = Sheets("原始数据").UsedRange
    For k = 2 To UBound(arr)
        Set sh = Worksheets(Format(arr(k, 1), "m月d日"))
        If Err.Number > 0 Then
            Worksheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = Format(arr(k, 1), "m月d日")
            Err.Clear
        End If
    Next
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "原始数据" Then
            Set d = CreateObject("scripting.dictionary")
            For k = 2 To UBound(arr)
                If Format(arr(k, 1), "m月d日") = sh.Name Then
                    d(arr(k, 3) & "|" & arr(k, 2)) = d(arr(k, 3) & "|" & arr(k, 2)) + arr(k, 4)
                End If
            Next k
            With sh
                .Range("a1").Offset(0, 0) = arr(1, 3)
                .Range("a1").Offset(0, 1) = arr(1, 2)
                .Range("a1").Offset(0, 2) = arr(1, 4)
                crr = d.keys
                drr = d.items
                For m = 1 To d.Count
                    .Range("a1").Offset(m, 0) = Split(crr(m - 1), "|")(0)
                    .Range("a1").Offset(m, 1) = Split(crr(m - 1), "|")(1)
                    .Range("a1").Offset(m, 2) = drr(m - 1)
                Next m
                .Sort.SortFields.Clear
                .Sort.SortFields.Add Key:=Range("A:A"), _
                                     SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                With .Sort
                    .SetRange Range("A1:C" & sh.Range("A65536").End(xlUp).Row)
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            End With
            Set d = Nothing
        End If
    Next sh
End Sub</FONT>


这段程序是提别人问题后最佳答案，看不懂，问题基本类似但这段程序哪里可以修改（需根据不同表格）那里不能修改？求详解 求助.zip (10.96 KB, 下载次数: 1)

2013-9-7 15:47 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

zjdh

2013-9-7 16:55

简单注释一下
Sub 整理数据()
    Dim sh As Worksheet, arr, k%, d, m%, crr, drr
    On Error Resume Next    '出错则运行下一句
    arr = Sheets("原始数据").UsedRange   '将数据赋于数组
    For k = 2 To UBound(arr)    '循环检查工作表
        Set sh = Worksheets(Format(arr(k, 1), "m月d日"))
        If Err.Number > 0 Then    '若不存在，则建立新表
            Worksheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = Format(arr(k, 1), "m月d日")
            Err.Clear
        End If
    Next
    For Each sh In ThisWorkbook.Sheets    '循环各表
        If sh.Name <> "原始数据" Then     '若不是"原始数据"表
            Set d = CreateObject("scripting.dictionary")   '建立字典
            For k = 2 To UBound(arr)     '数组循环
                If Format(arr(k, 1), "m月d日") = sh.Name Then   '若记录日期为当前工作表名
                    d(arr(k, 3) & "|" & arr(k, 2)) = d(arr(k, 3) & "|" & arr(k, 2)) + arr(k, 4)  '字典建立记录并累加数量
                End If
            Next k
            With sh
                .Range("a1").Offset(0, 0) = arr(1, 3)   '复制列标
                .Range("a1").Offset(0, 1) = arr(1, 2)
                .Range("a1").Offset(0, 2) = arr(1, 4)
                crr = d.keys    '取字典数据
                drr = d.items
                For m = 1 To d.Count   '逐条分解
                    .Range("a1").Offset(m, 0) = Split(crr(m - 1), "|")(0)
                    .Range("a1").Offset(m, 1) = Split(crr(m - 1), "|")(1)
                    .Range("a1").Offset(m, 2) = drr(m - 1)
                Next m
                .Sort.SortFields.Clear    '透视表处理
                .Sort.SortFields.Add Key:=Range("A:A"), _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                With .Sort
                    .SetRange Range("A1:C" & sh.Range("A65536").End(xlUp).Row)
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            End With
            Set d = Nothing    '释放字典
        End If
    Next sh
End Sub

跳转到最佳答案楼层

zjdh

简单注释一下
Sub 整理数据()
    Dim sh As Worksheet, arr, k%, d, m%, crr, drr
    On Error Resume Next    '出错则运行下一句
    arr = Sheets("原始数据").UsedRange   '将数据赋于数组
    For k = 2 To UBound(arr)    '循环检查工作表
        Set sh = Worksheets(Format(arr(k, 1), "m月d日"))
        If Err.Number > 0 Then    '若不存在，则建立新表
            Worksheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = Format(arr(k, 1), "m月d日")
            Err.Clear
        End If
    Next
    For Each sh In ThisWorkbook.Sheets    '循环各表
        If sh.Name <> "原始数据" Then     '若不是"原始数据"表
            Set d = CreateObject("scripting.dictionary")   '建立字典
            For k = 2 To UBound(arr)     '数组循环
                If Format(arr(k, 1), "m月d日") = sh.Name Then   '若记录日期为当前工作表名
                    d(arr(k, 3) & "|" & arr(k, 2)) = d(arr(k, 3) & "|" & arr(k, 2)) + arr(k, 4)  '字典建立记录并累加数量
                End If
            Next k
            With sh
                .Range("a1").Offset(0, 0) = arr(1, 3)   '复制列标
                .Range("a1").Offset(0, 1) = arr(1, 2)
                .Range("a1").Offset(0, 2) = arr(1, 4)
                crr = d.keys    '取字典数据
                drr = d.items
                For m = 1 To d.Count   '逐条分解
                    .Range("a1").Offset(m, 0) = Split(crr(m - 1), "|")(0)
                    .Range("a1").Offset(m, 1) = Split(crr(m - 1), "|")(1)
                    .Range("a1").Offset(m, 2) = drr(m - 1)
                Next m
                .Sort.SortFields.Clear    '透视表处理
                .Sort.SortFields.Add Key:=Range("A:A"), _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                With .Sort
                    .SetRange Range("A1:C" & sh.Range("A65536").End(xlUp).Row)
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            End With
            Set d = Nothing    '释放字典
        End If
    Next sh
End Sub

zjdh

分解_zjdh.rar (12.89 KB, 下载次数: 1)

2013-9-7 17:17 上传

点击文件名下载附件

CEL_hjl

zjdh 发表于 2013-9-7 17:17

1、<FONT style="BACKGROUND-COLOR: #f7f7f7">Option Explicit  前面这句什么意思？
2、帮忙解释下字典是什么怎么用？
3、像这样的引用的数据是三维数组？你们管这样的引用叫什么？（函数能做到?）

zjdh

1、<FONT style="BACKGROUND-COLOR: #f7f7f7"> 字体格式，与</FONT>对应
   Option Explicit  要求所有变量必须先定义后使用
2. 不是三言两语说得清的，你在论坛中搜索“字典”查找教材
3. 数组只是二维引用，要达到你的要求（要建立新表），无法用函数解决！

CEL_hjl

zjdh 发表于 2013-9-7 19:19
1、 字体格式，与对应
   Option Explicit  要求所有变量必须先定义后使用
2. 不是三言两语说得清的，你在 ...

哦知道了 ，谢谢