EXCEL的目錄

VANESSA

Book1(4).zip (60.98 KB)

下載次數: 24

2012-5-25 15:19

同一個檔內有很多很多的工作表,怎樣才能將這些工作表的名稱,彙整在"目錄"這個工作表的A欄?

register313

回復 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

對不起,我不知道這個VBA要怎麼COPY到檔案內,是要放到巨集嗎?
再按執行巨集嗎?可是沒成功吔,可以再教一下嗎,謝謝

Hsieh

回復 3# VANESSA
你應該是要做超連結吧，這樣也要返回目錄的操作

下載 (784.49 KB)

2012-5-25 16:30

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

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

u3003kimo

感謝分享,
VBA 果然是博大精深啊~~

Hsieh

回復 5# VANESSA


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

VANESSA

顯示"語譯錯誤",我把畫面貼在附檔 Doc1.zip (57.37 KB)

下載次數: 9

2012-6-8 16:47

,懇請版主幫忙

freeffly

很好用的代碼
我自己將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

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