Office中國(guó)論壇/Access中國(guó)論壇

標(biāo)題: VBA創(chuàng)建新工作簿并在內(nèi)按要求創(chuàng)建新表 [打印本頁(yè)]

作者: tanhong 時(shí)間: 2008-3-27 21:32
標(biāo)題: VBA創(chuàng)建新工作簿并在內(nèi)按要求創(chuàng)建新表
編程要求:
工作薄A.xls里sheet1 里a1=1001 ,a2=1002,a3=1003,a4=1004.......
通過(guò)VBA實(shí)現(xiàn)新建工作薄B.xls里的sheet1命名為1001，sheet2命名為1002，sheet3命名為1003，直至a(i)=""時(shí)結(jié)束

歡迎大家攻擂哦，看看有沒(méi)有更好的辦法

主要思路:
1、新建一個(gè)工作簿
2、在新建工作簿中，建立新表。新建表個(gè)數(shù)：先得到你A1到AN個(gè)單元格個(gè)數(shù)，來(lái)決定新建表的個(gè)數(shù)，因?yàn)榭紤]到新建工作簿中一般都會(huì)有三個(gè)表，那就是N減3，也就是說(shuō)要新建N-3個(gè)表
3、循環(huán)A1-AN區(qū)域取值并循環(huán)修改新建表的表名
4、在當(dāng)前路徑保存工作簿。就OK

實(shí)例圖：
[attach]29303[/attach]

我做的實(shí)例：[attach]29304[/attach]

作者: pureshadow 時(shí)間: 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 時(shí)間: 2008-3-27 21:54
啊哈.......
不好意思,
妖的EXCEL是設(shè)置成打開(kāi)只有一個(gè)SHEET的[:30]

作者: andymark 時(shí)間: 2008-3-27 21:59
呵呵,E版終于開(kāi)擂啦
支持一下

作者: tanhong 時(shí)間: 2008-3-27 22:20

原帖由 pureshadow 于 2008-3-27 21:54 發(fā)表
啊哈.......
不好意思,
妖的EXCEL是設(shè)置成打開(kāi)只有一個(gè)SHEET的[:30]

妖版主是在當(dāng)前工作簿中創(chuàng)建表，題目是要?jiǎng)?chuàng)建新工作簿哦，在新工作簿中創(chuàng)建表哦

作者: pureshadow 時(shí)間: 2008-3-27 23:30
同一工作表內(nèi)的代碼還不熟.......
跨工作表的更是生硬.......
現(xiàn)在要我跨工作簿......
[:30]

作者: pureshadow 時(shí)間: 2008-3-27 23:31

原帖由 andymark 于 2008-3-27 21:59 發(fā)表
呵呵,E版終于開(kāi)擂啦
支持一下

什么呀,前一個(gè)擂,已經(jīng)開(kāi)了幾層樓了.......
老大也不關(guān)注一下E版[:30]

作者: tanhong 時(shí)間: 2008-3-28 00:13
同意小妖的看法，老大不怎么關(guān)心E版哦。哈哈[:41]

作者: tmtony 時(shí)間: 2008-3-28 00:18
沒(méi)有啊, 看到你們打得熱火朝天,我插不上啊, 一會(huì)就到了第9樓啦.
這兩天基本上都在客戶, 只有晚上才能看看

作者: pureshadow 時(shí)間: 2008-3-28 20:38
老大向來(lái)是偏心的,我們都習(xí)慣了....[:41]

作者: 歡歡 時(shí)間: 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 "創(chuàng)建完成！", 64, "歡樂(lè)小爪"
      Application.ScreenUpdating = True
End Sub

作者: grass761 時(shí)間: 2008-3-31 15:41
標(biāo)題: 請(qǐng)教問(wèn)題
創(chuàng)建新工作表y.xls可以用這個(gè)方法
Set NewBook = Workbooks.Add
NewBook.SaveAs Filename:="D:\y.xls"

但是我想問(wèn)的是
假如我想通過(guò)文本框
為新建的工作表命名什么不可以呢

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

Set NewBook = Workbooks.Add
NewBook.SaveAs Filename:="D:\y.xls"
End Sub
請(qǐng)告訴我哦
謝謝

作者: tanhong 時(shí)間: 2008-3-31 20:42
NewBook.SaveAs Filename:="D:\" & y & ".xls"

作者: tanhong 時(shí)間: 2008-3-31 20:42
你試著按上面的修改試試看

作者: grass761 時(shí)間: 2008-4-1 16:25
標(biāo)題: 感謝并請(qǐng)教問(wèn)題
結(jié)果非常滿意
我想再問(wèn)的是我想反復(fù)讀取Sheet1中cells(1,1)內(nèi)數(shù)據(jù)（數(shù)據(jù)可以由外面獲得也可以由人為自行填寫(xiě)進(jìn)去），然后將讀取的數(shù)據(jù)依次填寫(xiě)到Sheet2中的單元格中，并且每次讀出保存的數(shù)據(jù)都對(duì)應(yīng)有讀出的時(shí)間。這個(gè)問(wèn)題您幫忙解答下。謝謝！

老師請(qǐng)幫忙解答下謝謝。

作者: tanhong 時(shí)間: 2008-4-1 18:09

原帖由 grass761 于 2008-4-1 16:25 發(fā)表
結(jié)果非常滿意
我想再問(wèn)的是我想反復(fù)讀取Sheet1中cells(1,1)內(nèi)數(shù)據(jù)（數(shù)據(jù)可以由外面獲得也可以由人為自行填寫(xiě)進(jìn)去），然后將讀取的數(shù)據(jù)依次填寫(xiě)到Sheet2中的單元格中，并且每次讀出保存的數(shù)據(jù)都對(duì)應(yīng)有讀出的時(shí)間。這 ...

建議把問(wèn)題發(fā)到論壇綜合區(qū)

作者: wodeyouxi 時(shí)間: 2008-10-9 17:09
謝謝您。我最需要的就是這個(gè)。

作者: huangkai945 時(shí)間: 2009-11-7 22:27
呵呵
先整回去好好研究下，感謝

作者: roych 時(shí)間: 2010-9-13 13:33
我也來(lái)試試吧：
第一次寫(xiě)VBA，不好的地方多多指教。
Sub SheetsAdd()
'計(jì)算非空單元格個(gè)數(shù)，獲取需要增加的工作表
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的單元格數(shù)值命名表
Sheets(i).Name = Sheets(1).Range("A" & i).Value
Next i
End Sub

作者: joyark 時(shí)間: 2011-4-24 07:22
老大向來(lái)是偏心的,我們都習(xí)慣了

作者: 劉青梅 時(shí)間: 2016-12-4 13:13
先整回去好好

歡迎光臨 Office中國(guó)論壇/Access中國(guó)論壇 (http://m.mzhfr.cn/)