[接龙...]部分程序代码注释，目录更新20051222

Long_III

7、菜单操作，全部菜单记录，隐藏或使其失效操作等，里面有一个数组方法一个非数组方法，速度却截然不同 5yPp2qMG.rar (10.38 KB, 下载次数: 545)

2005-8-8 10:18 上传

点击文件名下载附件
[接Long]大家把自己的代码都注释出来，供一些入门选手学习！

Sub hjs_数组()  '用数组方法处理，速度比直接处理快很多哦
    Dim a As CommandBarControls
    Dim b As CommandBarControl
    Dim buf(), i%
    Dim Itime
    
    Application.ScreenUpdating = False
    Itime = Timer       '记录程序运行当前的时间
    Cells.ClearContents '删除工作表内容（不包括格式）
    i = 2
    
    Set a = Application.CommandBars.FindControls '设置一个菜单集合
    ReDim buf(1 To a.Count + 1, 1 To 4) '重新定义数组，使其大小与集合的总记录数一致
        buf(1, 1) = "ID"
        buf(1, 2) = "Caption"
        buf(1, 3) = "Tag"
        buf(1, 4) = "Index" '设置标题
    
    For Each b In a
        buf(i, 1) = b.ID
        buf(i, 2) = b.Caption
        buf(i, 3) = b.Tag
        buf(i, 4) = b.Index '在菜单集合里循环，给数组赋值
        i = i + 1
    Next
    
    [A1].Resize(UBound(buf), 4).Value = buf  '根据数组给单元格赋值，单元格范围必须完全与数组大小一样

    Application.ScreenUpdating = True
    MsgBox "Done!共" & Format(Timer - Itime, "0.00") & "秒" '显示程序运行的总时间，格式为“0.00”
End Sub

Sub hjs1()  '使某菜单失效
    Dim i As CommandBarControl
    For Each i In Application.CommandBars.FindControls
        If i.ID = "30002" Then '在工作表中找到其对应的Id，如30002表示“文件”
            'i.Visible = False
            i.Enabled = False '要恢复只需设置为true即可
            Exit For
        End If
    Next
End Sub

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

既然是接龙，就希望大家也来粘贴自己的代码，并注释，而不是我一个这样做，还有，我复制注释后的代码在页面上，不知好不好，因为它比较占地方哦？

[此贴子已经被plxmm于2006-7-28 18:30:36编辑过]

Long_III

8、数组的优势！把数据放入数组里查找，并将结果也放入数组，最终赋值给单元格 ksxSbGVS.rar (85.88 KB, 下载次数: 516)

2005-8-8 10:44 上传

点击文件名下载附件

里面代码较多，主要看“更新单价模块”，这是早先给别人做的一个东西，还没完善，关于数组的代码如下：

Sub 更新单价()   '主要程序之一，更新单价 【数组方法】
    Dim sht As Worksheet
    Dim i%, irow%
    Dim t%
    Dim c As Range
    Dim arr, arr1, arr2()
    Dim aa
    aa = Timer
    
    Application.ScreenUpdating = False
    For Each sht In Sheets '在每一个表里循环
    With sht
        If Textsht(sht) Then '如果表属于要计算单价的表，则【这是一个辅助函数，在模块基础里有】
            irow = .[j65536].End(xlUp).Row '已j列为标准判断数据的最后一列
            .Range("z:ab").ClearContents   '每次查找时候删除原有数据
            arr = .Range("j1:j" & irow) '定义一个查找项的数组，此数组arr是从1到irow
            arr1 = .Range("Q1:Q" & irow) '定义一个数量的数组
            ReDim arr2(1 To irow, 1 To 2) '重新定义一个新数组，2列，包含单价和金额
            
            For i = 2 To irow
                If arr(i, 1) <> "" Then '查找项不为空时
                    Set c = Price.Columns(1).Find(arr(i, 1), lookat:=xlWhole) '在单价表里查找
                    If Not c Is Nothing Then '如果找到的话则给数组赋值
                        arr2(i, 1) = c.Offset(0, 5)
                        arr2(i, 2) = arr2(i, 1) * arr1(i, 1) '金额＝ 单价 * 数量
                    End If
                End If
                Set c = Nothing
            Next
            
            arr2(1, 1) = "单价"
            arr2(1, 2) = "金额"
            .Range("z1:aa" & irow) = arr2 '赋值到单元格里
            
            .[ab1] = Application.Sum(.Range("aa:aa")) '计算AA列的总和
        End If
    End With
    Next
    Application.ScreenUpdating = True
    MsgBox "程序运行完成，单价已更新,耗时" & Format(Timer - aa, "0.00") & "秒"
    
End Sub

[此贴子已经被plxmm于2006-7-28 18:31:26编辑过]

Long_III

9、来一个比较简单的数组例子，转换表的格式 zUzWa1vY.rar (9.41 KB, 下载次数: 454)

2005-8-8 14:22 上传

点击文件名下载附件
[接Long]大家把自己的代码都注释出来，供一些入门选手学习！

[用数组的好处就是速度能提高很多，也许是5～10倍]

Sub hjs()
    Dim irow%, icol%, k%
    Dim rng As Range
    Dim arr, arr1()
    Dim aa
    aa = Timer
    Application.ScreenUpdating = False
        Set rng = Sheet1.[a1].CurrentRegion  '转换成数组之后操作,速度可以提高N倍
        arr = rng '定义一个数组等于rng区域
        
        k = 1
        ReDim arr1(1 To rng.Count, 0) '重新定义一个与转换之后的单元格大小相等的数组，这个0一定要
        
        For icol = 1 To rng.Columns.Count
            For irow = 1 To rng.Rows.Count
                arr1(k, 0) = arr(irow, icol)  '行列转换赋值
                    k = k + 1
            Next
        Next
        
        Sheet2.Range("a:a").ClearContents
        Sheet2.Range("a1:a" & rng.Count) = arr1 '给第二个表的a列赋值
    Application.ScreenUpdating = True
    MsgBox "Done！共" & Format(Timer - aa, "0.0000") & "秒" '记录所用的时间
End Sub

【附：如果这3个数组都看完了，可以去这里看看这个用数组处理的，http://club.excelhome.net/viewthread.php?tid=115421，很经典的，2005-8-11 17：29】

【用数组，速度是显而易见的，大家还可以看看这个例子http://club.excelhome.net/viewthread.php?tid=115433，代码很简单，用数组处理却产生了天壤之别的差距，时间从几分钟提速到1秒钟哦】
【还来一个例子   把文本型日期一次转换给日期型格式

[此贴子已经被plxmm于2006-7-28 18:32:18编辑过]

york888

支持!对初学或正学VBA的朋友很有用,受益非浅!

lj1226189

ReDim arr1(1 To rng.Count, 0) '重新定义一个与转换之后的单元格大小相等的数组，这个0一定要

数组中为什么是0而不能是1呢？

Long_III

如果这里写1的话，类似与这个数组为ReDim arr1(1 To rng.Count, 0 to 1)，不是一维数组了

对于两列的话就可以写ReDim arr1(1 To rng.Count, 1)或者ReDim arr1(1 To rng.Count, 1 to 2)

lj1226189

再问这一句Sheet1.[a1].CurrentRegion 是什么意思！

相信这个帖子即使不置顶也会变成永不沉没的帖子！

Long_III

CurrentRegion在帮助里是这么解释的，“返回 Range 对象，该对象代表当前的区域。当前区域是一个边缘是任意空行和空列组合成的范围。只读”

当前区域，用快捷键操作，类似按Ctrl+A

a1的当前区域，就是选中a1，按Ctrl+A，而形成的一个范围，自己试试吧

17小菜

十分非常很特别的感谢龙三老大!

来个环境设置:

Private Sub Workbook_Open() With Application '设置运行环境 .ScreenUpdating = False '关闭屏幕刷新 .Visible = False'隐藏EXCEL .CommandBars("Standard").Visible = False '隐藏常用菜单 .CommandBars("Formatting").Visible = False '隐藏格式菜单 .DisplayFormulaBar = False '关闭编辑栏 .DisplayAlerts = False,关闭系统提示 .Calculation = xlManual '手动重算 .CalculateBeforeSave = False '关闭保存前自动重算 .MaxChange = 0.001 .Iteration = True '迭代计算True .Caption = "17小菜祝您快乐!" '修改EXCEL标题 End With ActiveWorkbook.PrecisionAsDisplayed = False '关闭以显示精度为准

End Sub

[此贴子已经被作者于2005-8-20 14:33:27编辑过]

UNARTHUR

才看到，绝对支持！记得刚学vba时多希望看到有高手注释过的代码。龙三兄的倡议很好，支持并感谢！[em17][em17]