Office中国论坛/Access中国论坛

标题: VBA创建新工作簿并在内按要求创建新表 [打印本页]

作者: tanhong 时间: 2008-3-27 21:32
标题: VBA创建新工作簿并在内按要求创建新表
编程要求:
工作薄A.xls里sheet1 里a1=1001 ,a2=1002,a3=1003,a4=1004.......
通过VBA实现新建工作薄B.xls里的sheet1命名为1001，sheet2命名为1002，sheet3命名为1003，直至a(i)=""时结束

欢迎大家攻擂哦，看看有没有更好的办法

主要思路:
1、新建一个工作簿
2、在新建工作簿中，建立新表。新建表个数：先得到你A1到AN个单元格个数，来决定新建表的个数，因为考虑到新建工作簿中一般都会有三个表，那就是N减3，也就是说要新建N-3个表
3、循环A1-AN区域取值并循环修改新建表的表名
4、在当前路径保存工作簿。就OK

实例图：
[attach]29303[/attach]

我做的实例：[attach]29304[/attach]

作者: pureshadow 时间: 2008-3-27 21:53
Sub Macro1()

Dim x As Long
Dim i As Long

x = Sheets("sheet1").Range("a65536").End(xlUp).Row
For i = 2 To x

Sheets.Add after:=Sheets(i - 1)
ActiveSheet.Name = Sheets("sheet1").Range("a" & i)
Sheets("sheet1").Select

Next

End Sub

[ 本帖最后由 pureshadow 于 2008-3-27 21:55 编辑 ]

作者: pureshadow 时间: 2008-3-27 21:54
啊哈.......
不好意思,
妖的EXCEL是设置成打开只有一个SHEET的[:30]

作者: andymark 时间: 2008-3-27 21:59
呵呵,E版终于开擂啦
支持一下

作者: tanhong 时间: 2008-3-27 22:20

原帖由 pureshadow 于 2008-3-27 21:54 发表
啊哈.......
不好意思,
妖的EXCEL是设置成打开只有一个SHEET的[:30]

妖版主是在当前工作簿中创建表，题目是要创建新工作簿哦，在新工作簿中创建表哦

作者: pureshadow 时间: 2008-3-27 23:30
同一工作表内的代码还不熟.......
跨工作表的更是生硬.......
现在要我跨工作簿......
[:30]

作者: pureshadow 时间: 2008-3-27 23:31

原帖由 andymark 于 2008-3-27 21:59 发表
呵呵,E版终于开擂啦
支持一下

什么呀,前一个擂,已经开了几层楼了.......
老大也不关注一下E版[:30]

作者: tanhong 时间: 2008-3-28 00:13
同意小妖的看法，老大不怎么关心E版哦。哈哈[:41]

作者: tmtony 时间: 2008-3-28 00:18
没有啊, 看到你们打得热火朝天,我插不上啊, 一会就到了第9楼啦.
这两天基本上都在客户, 只有晚上才能看看

作者: pureshadow 时间: 2008-3-28 20:38
老大向来是偏心的,我们都习惯了....[:41]

作者: 欢欢 时间: 2008-3-29 19:39
Sub 新建工作簿指定工作表名()  '方法二
  Dim intName%, myRng&
Application.ScreenUpdating = False
   myRng = Sheet1.[A65536].End(xlUp).Row
   Application.SheetsInNewWorkbook = myRng
      Workbooks.Add
For intName = 1 To myRng
Sheets("sheet" & intName).Name = Sheet1.Cells(intName, 1)
Next intName
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\小爪.xls"
   ActiveWorkbook.Close savechanges:=True
   MsgBox "创建完成！", 64, "欢乐小爪"
      Application.ScreenUpdating = True
End Sub

作者: grass761 时间: 2008-3-31 15:41
标题: 请教问题
创建新工作表y.xls可以用这个方法
Set NewBook = Workbooks.Add
NewBook.SaveAs Filename:="D:\y.xls"

但是我想问的是
假如我想通过文本框
为新建的工作表命名什么不可以呢

我的程序是这样的
Private Sub CommandButton1_Click()
Dim y As String
y = x.Text

Set NewBook = Workbooks.Add
NewBook.SaveAs Filename:="D:\y.xls"
End Sub
请告诉我哦
谢谢

作者: tanhong 时间: 2008-3-31 20:42
NewBook.SaveAs Filename:="D:\" & y & ".xls"

作者: tanhong 时间: 2008-3-31 20:42
你试着按上面的修改试试看

作者: grass761 时间: 2008-4-1 16:25
标题: 感谢并请教问题
结果非常满意
我想再问的是我想反复读取Sheet1中cells(1,1)内数据（数据可以由外面获得也可以由人为自行填写进去），然后将读取的数据依次填写到Sheet2中的单元格中，并且每次读出保存的数据都对应有读出的时间。这个问题您帮忙解答下。谢谢！

老师请帮忙解答下谢谢。

作者: tanhong 时间: 2008-4-1 18:09

原帖由 grass761 于 2008-4-1 16:25 发表
结果非常满意
我想再问的是我想反复读取Sheet1中cells(1,1)内数据（数据可以由外面获得也可以由人为自行填写进去），然后将读取的数据依次填写到Sheet2中的单元格中，并且每次读出保存的数据都对应有读出的时间。这 ...

建议把问题发到论坛综合区

作者: wodeyouxi 时间: 2008-10-9 17:09
谢谢您。我最需要的就是这个。

作者: huangkai945 时间: 2009-11-7 22:27
呵呵
先整回去好好研究下，感谢

作者: roych 时间: 2010-9-13 13:33
我也来试试吧：
第一次写VBA，不好的地方多多指教。
Sub SheetsAdd()
'计算非空单元格个数，获取需要增加的工作表
SheetCount = Application.WorksheetFunction.CountA(Sheets(1).Range("A:A"))
For i = 1 To SheetCount - 1
'增加表
Sheets.Add after:=Sheets(i)
Next i
For i = 1 To SheetCount
'提取Sheet1的单元格数值命名表
Sheets(i).Name = Sheets(1).Range("A" & i).Value
Next i
End Sub

作者: joyark 时间: 2011-4-24 07:22
老大向来是偏心的,我们都习惯了

作者: 刘青梅 时间: 2016-12-4 13:13
先整回去好好

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)