»
首页
|
手机数码
|
汽车资讯
|
游戏硬件
|
评测专题
|
手机壁纸
|
海淘值得买
|
度假
|
求职招聘
|
广告联系
» 您尚未登录:请
登录
|
注册
|
标签
|
帮助
|
小黑屋
|
TGFC Lifestyle
»
完全数码讨论区
» excle高手进,请教一个问题。。。。
发新话题
发布投票
发布商品
发布悬赏
发布活动
发布辩论
发布视频
打印
[电脑]
excle高手进,请教一个问题。。。。
越过俺的尸体
魔王撒旦
塔利班班主任
帖子
5395
精华
0
积分
22890
激骚
28 度
爱车
主机
相机
手机
注册时间
2002-11-21
发短消息
加为好友
当前离线
1
#
大
中
小
发表于 2008-3-12 22:17
显示全部帖子
用VBA啊 同志 这样头发白了也搞不完的啊
UID
6193
帖子
5395
精华
0
积分
22890
交易积分
1
阅读权限
40
在线时间
4668 小时
注册时间
2002-11-21
最后登录
2023-4-9
查看详细资料
TOP
越过俺的尸体
魔王撒旦
塔利班班主任
帖子
5395
精华
0
积分
22890
激骚
28 度
爱车
主机
相机
手机
注册时间
2002-11-21
发短消息
加为好友
当前离线
2
#
大
中
小
发表于 2008-3-12 22:24
显示全部帖子
容我想想
Sub create folders()
DIM FOLDER AS STRING
FOR I=1 TO 2000
FOLDER=CELLs(i,2).value
mkdir "D:\"+folder
next i
end sub
上面这个可以D盘根目录下创建2000个文件夹
[
本帖最后由 越过俺的尸体 于 2008-3-12 22:26 编辑
]
UID
6193
帖子
5395
精华
0
积分
22890
交易积分
1
阅读权限
40
在线时间
4668 小时
注册时间
2002-11-21
最后登录
2023-4-9
查看详细资料
TOP
越过俺的尸体
魔王撒旦
塔利班班主任
帖子
5395
精华
0
积分
22890
激骚
28 度
爱车
主机
相机
手机
注册时间
2002-11-21
发短消息
加为好友
当前离线
3
#
大
中
小
发表于 2008-3-12 22:32
显示全部帖子
LZ
现在必须知道是序列号下面那三个零件号在什么位置上?
[
本帖最后由 越过俺的尸体 于 2008-3-12 22:34 编辑
]
UID
6193
帖子
5395
精华
0
积分
22890
交易积分
1
阅读权限
40
在线时间
4668 小时
注册时间
2002-11-21
最后登录
2023-4-9
查看详细资料
TOP
越过俺的尸体
魔王撒旦
塔利班班主任
帖子
5395
精华
0
积分
22890
激骚
28 度
爱车
主机
相机
手机
注册时间
2002-11-21
发短消息
加为好友
当前离线
4
#
大
中
小
发表于 2008-3-13 14:15
显示全部帖子
我试过了 可以运行 运行结果是在D盘下生成一个叫test的文件夹 里面就是LZ所要的东西了 2000多行可能要运行半个小时左右,不过要注意的是 你说的这2000多行的设备号和序列号不能为空或者重复
运行VBA什么权限都不用,打开你的EXCEL文件 --工具--宏--VISAL BASIC编辑器 把下面代码粘进去运行就可以了
还有 这段代码需要引用WORD,在VBA编辑器下 工具--引用--MICROSOFT WORD OBJECT LIBRARY 钩选上就可以了
Sub createfolders()
Dim folder As String
Dim currentpath As Variant
Dim worddoc(3000, 2) As String
Dim docApp As New Word.Application
Dim docDoc As Word.Document
Set chk = CreateObject("Scripting.FileSystemObject")
If chk.FolderExists("D:\test") = False Then
MkDir "d:\test"
Else: MsgBox "路径已存在!"
Exit Sub
End If
RowCount = ActiveSheet.[b1].CurrentRegion.Rows.Count
For i = 1 To RowCount
folder = Cells(i, 2).Value
If folder <> "" Then
MkDir "D:\test\" + folder
currentpath = "D:\test\" + folder + "\"
Else
Exit Sub
End If
worddoc(i - 1, 0) = Cells(i, 3).Value
worddoc(i - 1, 1) = Cells(i, 4).Value
worddoc(i - 1, 2) = Cells(i, 5).Value
docApp.Visible = False
Set docDoc = docApp.Documents.Add
docDoc.SaveAs currentpath + worddoc(i - 1, 0) + ".doc"
docDoc.SaveAs currentpath + worddoc(i - 1, 1) + ".doc"
docDoc.SaveAs currentpath + worddoc(i - 1, 2) + ".doc"
docApp.DisplayAlerts = False
docDoc.Close
docApp.Quit
Set docDoc = Nothing
Set docApp = Nothing
Next i
End Sub
不知道LZ的文件是什么样子 也许会有些我没注意到的小毛病
[
本帖最后由 越过俺的尸体 于 2008-3-13 14:23 编辑
]
UID
6193
帖子
5395
精华
0
积分
22890
交易积分
1
阅读权限
40
在线时间
4668 小时
注册时间
2002-11-21
最后登录
2023-4-9
查看详细资料
TOP
越过俺的尸体
魔王撒旦
塔利班班主任
帖子
5395
精华
0
积分
22890
激骚
28 度
爱车
主机
相机
手机
注册时间
2002-11-21
发短消息
加为好友
当前离线
5
#
大
中
小
发表于 2008-3-13 14:16
显示全部帖子
另外 5楼同学说的对 我小紧张了一下:D
UID
6193
帖子
5395
精华
0
积分
22890
交易积分
1
阅读权限
40
在线时间
4668 小时
注册时间
2002-11-21
最后登录
2023-4-9
查看详细资料
TOP
控制面板首页
密码修改
积分交易
积分记录
公众用户组
基本概况
版块排行
主题排行
发帖排行
积分排行
交易排行
在线时间
管理团队
管理统计