ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: Long_III

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

  [复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2005-9-21 16:26 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

45、按查询结果自动生成图形。原处为http://club.excelhome.net/viewthread.php?tid=123461,操作:在A2输入要查询的,a2下面也可以输入,会依次查询,双击E列的数据可以查看原始数据,如双击E5

qoatmZbD.rar (11.59 KB, 下载次数: 189)

[此贴子已经被作者于2005-9-21 16:31:40编辑过]

Klyq50qG.rar

21.88 KB, 下载次数: 166

[接龙...]部分程序代码注释,供一些入门选手学习!

TA的精华主题

TA的得分主题

 楼主| 发表于 2005-9-21 16:33 | 显示全部楼层

46、特殊的数据排序,过程需要反复理解。代码过于复杂,建议有兴趣的可以看看

先占个地, yv7z9asv.rar (14.09 KB, 下载次数: 168)

原处在http://club.excelhome.net/viewthread.php?tid=93204

[此贴子已经被作者于2005-9-22 8:57:07编辑过]

YGqfdFTm.rar

13.31 KB, 下载次数: 81

TA的精华主题

TA的得分主题

发表于 2005-9-21 16:54 | 显示全部楼层
长三兄真是劳苦功高,辛苦了!版主应该奖励才是。

TA的精华主题

TA的得分主题

发表于 2005-9-21 18:12 | 显示全部楼层

楼主:辛苦!谢谢!

能不能在1楼做个目录,一目了然、提高效率。

我无法改写你的1楼,否则我就替你加上了。

TA的精华主题

TA的得分主题

发表于 2005-9-21 19:58 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
龙老师又有新东西喽!快来下欧!

TA的精华主题

TA的得分主题

发表于 2005-9-22 17:57 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
好贴一定要支持~~~!

TA的精华主题

TA的得分主题

 楼主| 发表于 2005-9-27 10:28 | 显示全部楼层

46、Scripting.FileSystemObject对象的学习,用代码操作文本文件、文件夹及驱动器。这里有一份详细的帮助,建议打印出来仔细阅读http://www.officefans.net/cdb/vi ... d=45704&fpage=3

aurora兄也做了一个很好的例子,“列出某文件夹下所有子文件夹之路径及大小 ”http://www.officefans.net/cdb/vi ... d=43019&fpage=2

我也是在学习他们资料的时候大致做了一个简单例子,希望能给初学者一点帮助。 KOqWv9ze.rar (12.89 KB, 下载次数: 172)

,代码:

Const S$ = "E:\HUJINSONG" '定义一个常量,新增的文件夹的路径及名称

Sub Add_folder() '新增文件夹及子文件夹、工作簿等,运行之后在E盘看看结果 Dim fs As Scripting.FileSystemObject Dim fl As Scripting.File Dim wb As Workbook Dim s1$

Set fs = CreateObject("Scripting.filesystemobject")

If fs.FolderExists(S) Then MsgBox "文件已存在哦,请确认": Exit Sub fs.CreateFolder S '增加一个文件夹,E盘的hujinsong For i = 1 To 10 fs.CreateFolder S & "\" & Format(i, "000") '增加10个子文件夹001到010 Next

s1 = S & "\001\" & "新工作簿.xls" '一个新增的工作簿的名称及路径 Set wb = Workbooks.Add With wb .Sheets(1).[a1].Value = "试验工作簿" .SaveAs Filename:=s1 .Close End With '在第一个文件夹里增加一个新工作簿 Set fl = fs.GetFile(s1) '得到这个新增工作簿对象,赋值为fl With fl .Copy S & "\002\" '复制到第二个文件夹里 .Copy S & "\005\" '复制到第5个文件夹里 .Copy S & "\005\hjsong.xls" '直接在copy时,也更改它的名字 End With

End Sub

Sub Show_All() '显示文件夹的属性、内容、大小等,如果文件夹的大小为0则删除 Dim fs As Scripting.FileSystemObject Dim f As Scripting.Folder Dim f1 As Scripting.Folder

Set fs = New Scripting.FileSystemObject '另外一种方式 If Not fs.FolderExists(S) Then MsgBox "文件不存在哦,请确认": Exit Sub Set f = fs.GetFolder(S) '得到s文件夹对象

For Each f1 In f.SubFolders '在子文件夹里做一个循环 Debug.Print f1, f1.Size, f1.Attributes 'f1为子文件夹的全部路径,size表示它的大小,在VBE中按Ctrl+G查看结果 If f1.Size = 0 Then f1.Delete '假如子文件夹大小为0,则删除 Next Set fs = Nothing End Sub

Sub Del_folder() '删除文件夹 Dim fs As Scripting.FileSystemObject Set fs = New Scripting.FileSystemObject On Error Resume Next '防止删除的文件夹不存在,产生错误 fs.DeleteFolder S '删除新建的文件夹 End Sub

【注】对于Dim fs As Scripting.FileSystemObject,需要引用“Miscosoft scripting runtime”,例子中借用大师的作品在打开时自动引用,如果不引用的话,就不能这样定义,只能在程序做好之后,把上面的定义都修改为Dim fs As,大家可以试试。

TA的精华主题

TA的得分主题

发表于 2005-9-27 12:32 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
我建议要不龙三哥推出一些未注释的代码,让其他人来注释并说明其主要功能。

TA的精华主题

TA的得分主题

发表于 2005-9-27 13:46 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

谢谢!我代表菜鸟向各位大侠敬礼

TA的精华主题

TA的得分主题

发表于 2005-9-27 14:10 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

请楼主及各位高手帮个忙,帮我解决一个单元格内多个值拆分在多个单元格的问题,小弟谢先了。 e3bKqJnL.rar (1.69 KB, 下载次数: 59)

请发到:danielcm@sina.com

[此贴子已经被作者于2005-9-27 14:13:59编辑过]
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-9-24 13:25 , Processed in 0.045242 second(s), 7 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表