如何对多个表格生成目录，紧急！请大侠们帮忙！

wangil

luhnyu008 发表于 2011-11-2 14:20
斑竹们，帮忙啊！

这样的吗？                             

luhnyu008

不是上面的情况，应该是这样的！

wangil

没明白                                 

luhnyu008

就是单独在一个工作簿中对其他工作簿中的sheet生成目录，也就是目录所在的表格批量链接到其他工作的sheet，手动添加太慢了！

AVEL

1. Sub l()
   
2.     Dim brr(), arr()
   
3.     Dim i%, n%
   
4.     Dim Mypath$, Myname$, sh As Worksheet
   
5.     Mypath = ThisWorkbook.Path & ""
   
6.     Myname = Dir(Mypath & "*.xls*")
   
7.     Application.ScreenUpdating = False
   
8.     Do While Myname <> ""
   
9.         If Myname <> ThisWorkbook.Name Then
   
10.             With GetObject(Mypath & Myname)
    
11.                 For Each sh In .Sheets
    
12.                     If Application.WorksheetFunction.CountA(sh.Cells) > 0 Then
    
13.                         n = n + 1
    
14.                         ReDim Preserve arr(1 To n)
    
15.                         ReDim Preserve brr(1 To n)
    
16.                         arr(n) = Mypath & Myname & "#" & sh.Name & "!A1"
    
17.                         brr(n) = sh.Name
    
18.                     End If
    
19.                 Next
    
20.                 .Close False
    
21.             End With
    
22.         End If
    
23.         Myname = Dir
    
24.     Loop
    
25.     Sheet1.Columns("a:A").Clear
    
26.     For i = 1 To n
    
27.         Sheet1.Hyperlinks.Add Range("a" & i), arr(i), , , brr(i)
    
28.     Next
    
29.     Application.ScreenUpdating = True
    
30. End Sub

复制代码

AVEL

测试附件看看

shaowu459

luhnyu008 发表于 2011-11-2 14:20
斑竹们，帮忙啊！

参考附件，应该是可以用的。测试一下看看

luhnyu008

16的能用，谢谢了啊！17楼斑竹做得运行出现错误，不知道什么原因啊！

shaowu459

luhnyu008 发表于 2011-11-5 14:30
16的能用，谢谢了啊！17楼斑竹做得运行出现错误，不知道什么原因啊！

我这里可以使用，我还完善了一版，周一到了公司发出来。

luhnyu008

shaowu459 发表于 2011-11-5 17:39
我这里可以使用，我还完善了一版，周一到了公司发出来。

版主，能否把我求助的帖子解决办法再帮忙发下！