Board logo

標題: EXCEL的目錄 [打印本頁]
作者: VANESSA    時間: 2012-5-25 15:19     標題: EXCEL的目錄

[attach]11144[/attach]同一個檔內有很多很多的工作表,怎樣才能將這些工作表的名稱,彙整在"目錄"這個工作表的A欄?
作者: register313    時間: 2012-5-25 15:35

回復 1# VANESSA

VBA
  1. Sub Sortsheets()
  2.     Dim S%, C%, SH%, AR()
  3.     SH = Worksheets.Count - 1
  4.     ReDim AR(1 To SH)
  5.     C = 1
  6.     For S = 1 To Worksheets.Count
  7.       If Sheets(S).Name <> "目錄" Then
  8.          AR(C) = Sheets(S).Name
  9.          C = C + 1
  10.       End If
  11.     Next S
  12.     Sheets("目錄").[A:A] = ""
  13.     Sheets("目錄").[A1].Resize(SH, 1) = Application.Transpose(AR)
  14. End Sub
複製代碼
作者: VANESSA    時間: 2012-5-25 16:03

對不起,我不知道這個VBA要怎麼COPY到檔案內,是要放到巨集嗎?
再按執行巨集嗎?可是沒成功吔,可以再教一下嗎,謝謝
作者: Hsieh    時間: 2012-5-25 16:24

本帖最後由 Hsieh 於 2012-5-25 16:32 編輯

回復 3# VANESSA
你應該是要做超連結吧，這樣也要返回目錄的操作
[attach]11146[/attach]
  1. Private Sub Worksheet_Activate()
  2. Dim A As Range, Sh As Worksheet
  3. Columns("A:A").Clear
  4. r = 1
  5. For Each Sh In Sheets
  6.    If Sh.Name <> Me.Name Then
  7.       Set A = Cells(r, 1)
  8.            Me.Hyperlinks.Add Anchor:=A, Address:="", SubAddress:= _
  9.         "'" & Sh.Name & "'!A1", TextToDisplay:=Sh.Name
  10.        Sh.Hyperlinks.Add Anchor:=Sh.[A1], Address:="", SubAddress:= _
  11.         "'目錄'!A1", TextToDisplay:="返回目錄"
  12.        r = r + 1
  13.    End If
  14. Next
  15. End Sub
複製代碼
作者: VANESSA    時間: 2012-6-6 13:24

好怪,為什麼我怎麼試都不行
1.在工作表"目錄"按右鍵,選取所有工作表
2.選"檢視程式碼'貼上程式
3按'關閉'回到工作表
4.等...等...等好久都沒出來,請問我到底是哪做錯了
作者: u3003kimo    時間: 2012-6-6 13:59

感謝分享,
VBA 果然是博大精深啊~~
作者: Hsieh    時間: 2012-6-6 15:43

回復 5# VANESSA


    好怪,為什麼我怎麼試都不行
1.在工作表"目錄"按右鍵,選取所有工作表
不需要選取所有工作表
工作表"目錄"按右鍵，選"檢視程式碼'貼上程式
然後回到工作表後切換工作表試試看
作者: VANESSA    時間: 2012-6-8 16:48

顯示"語譯錯誤",我把畫面貼在附檔[attach]11323[/attach],懇請版主幫忙
作者: freeffly    時間: 2013-4-16 16:42

很好用的代碼
我自己將A1修改成如下面代碼
根據後面資料的位置去判斷
可能每個人的資料不一樣
再自行修改
" & Sh.Range("iv3").End(xlToLeft).Offset(, 1).Address & "
  1. Dim A As Range, Sh As Worksheet
  2. Columns("A:A").Clear
  3. r = 1
  4. For Each Sh In Sheets
  5.    If Sh.Name <> Me.Name Then
  6.       Set A = Cells(r, 1)
  7.            Me.Hyperlinks.Add Anchor:=A, Address:="", SubAddress:= _
  8.         "'" & Sh.Name & "'!" & Sh.Range("iv3").End(xlToLeft).Offset(, 1).Address & "", TextToDisplay:=Sh.Name
  9.        Sh.Hyperlinks.Add Anchor:=Sh.Range("iv3").End(xlToLeft).Offset(, 1), Address:="", SubAddress:= _
  10.         "'目錄'!A1", TextToDisplay:="返回目錄"
  11.        r = r + 1
  12.    End If
  13. Next
複製代碼
作者: hydraulic    時間: 2013-4-17 00:05

如果每個工作表A:A欄位都有資料的時候呢,這樣子要對每個工作表插入一整欄位先吧



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)