常见字典用法集锦及代码详解

sc6231565

谢谢蓝老师 ，是你的代码让我入的门，谢谢你写的这么详细

三流高手

学习好文章，谢谢版主！

tcl6303

谢谢蓝老师 ，是你的代码让我入了门，我在工作中用你的字典法解决了很多问题，例如：我用Execel自定义工具中 的宏汇总当前文件夹下的所有电子表，给我带来了很大方便，谢谢你！不过偶然又发现了一个问题，当单元格字符数多的情况下，转置函数不可用，我的代码如下：
Sub 汇总数据()
    On Error Resume Next
    Dim sh As Worksheet, Wb As Workbook
    x = MsgBox("是汇总工作簿的当前表，否则汇总工作簿的各个表！ ", vbYesNoCancel + vbInformation, "当前文件夹内工作表汇总设置")
    If x = 2 Then Exit Sub
    hh = Val(InputBox("请输入汇总数据的起始行号！", "当前文件夹内工作表汇总设置", "2"))
    If hh < 1 Then Exit Sub
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Set B = CreateObject("Scripting.Dictionary")
    If x <> 2 Then
       lj = ThisWorkbook.Path
       wj = Dir(lj & "\*.xls")
       Do While wj <> ""
          If wj <> ThisWorkbook.Name Then
             Set Wb = Workbooks.Open(lj & "\" & wj)
             For Each sh In Wb.Worksheets
               If Application.CountA(sh.Cells) > 0 Then
                 hmax = sh.UsedRange.Rows.Count + sh.UsedRange.Row - 1
                 If (x = 7 Or (x = 6 And sh.Name = Wb.ActiveSheet.Name)) And hmax >= hh Then
                    If B.Count = 0 Then
                       hh1 = Application.Max(hh - 1, 1)
                       lh = sh.Cells(hh1, 256).End(xlToLeft).Column
                       B("工作簿" & " " & "工作表" & " " & "序号") = sh.Cells(hh1, 1).Resize(1, lh)
                    End If
                    For Each D In sh.Range("B" & hh & ":B" & hmax)
                      B(Replace(Wb.Name, ".xls", "") & " " & sh.Name & " " & B.Count) = sh.Cells(D.Row, 1).Resize(1, lh)
                    Next
                 End If
               End If
             Next
             Wb.Close False
          End If
          wj = Dir
       Loop
    End If
    If B.Count > 1 Then
       Set Wb = Workbooks.Add
       With [A1].Resize(B.Count, lh)
         .NumberFormatLocal = "@"
         .Value = Application.Transpose(Application.Transpose(B.items))
       End With
       Cells(1, lh + 1).Resize(B.Count, 1) = Application.Transpose(B.keys)
       Call 整理数据
       ActiveSheet.Name = "汇总数据(" & B.Count - 1 & ")"
       Wb.SaveAs ThisWorkbook.Path & "\" & "汇总数据(" & B.Count - 1 & ").xls"
    End If
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
End Sub
调试时发现错误在  .Value = Application.Transpose(Application.Transpose(B.items)) ，经过查找可能是字多转置函数受限造成的，麻烦蓝老师看一看应该怎样解决这个问题？谢谢各位老师！

excelgogo

占位置学习，不是为灌水，只为有个地儿

jzpcwl

占位置学习，不是为灌水，只为有个地儿{:soso_e113:}

feng5064

很强大，这个一定要收藏！

carl712

太长了，没看懂

djajan

蓝桥玄霜 发表于 2010-10-18 12:50
实例3  A列中显示1 ~ 1000中被6除余1和余5 的数字
一、问题的提出：
有1、2、3…1000一千个数字，要求编写 ...

列4的红色标注的话不是很明白：能举个例子吗？谢谢！

11、GoTo 100 ：Goto语句用于无条件地转移到过程中指定的行。这里采用跳出For i循环，一是为了减少循环的次数，比如"MOTO"找到的话，后面3个就不需要找了；二是为了跳过两个小循环之后的其它品牌加入第3个字典的d2(Arr(x, 1)) = ""语句。

hentan

斑竹，你真的就是一个活菩萨。太感谢您了，早看到您的大作，也不至于浪费那么多时间揣摩。

janse_wang

標示一下，