[已解决]提取工作表名字，分别提取。

张雄友

提取工作表名字，分别提取。

最佳答案

月排行榜 / 总排行榜

zjdh

2014-9-16 20:53

提取工作表名字.rar (10.64 KB, 下载次数: 27)

2014-9-16 20:53 上传

点击文件名下载附件

跳转到最佳答案楼层

wp8680

1. Sub TIQI()
   
2.     Dim Filename As String, mypath As String, k As Integer
   
3.     Dim wb As Workbook, sh As Worksheet, brr(0 To 100, 1 To 6), thiswb
   
4.     '    On Error Resume Next
   
5.     '    Application.DisplayAlerts = False    '表示禁止显示提示和警告消息
   
6.     '    Application.ScreenUpdating = False    '表示停止屏幕更新
   
7.     thiswb = ThisWorkbook.Name
   
8.     mypath = ThisWorkbook.Path & ""
   
9.     Range("B4:G100").ClearContents
   
10.     Filename = Dir(mypath & "*.xls")
    
11.     Do
    
12.         If Filename <> thiswb Then
    
13.             k = k + 1
    
14.             M = 0
    
15.             Set wb = Workbooks.Open(mypath & Filename)
    
16.             brr(M, k) = wb.Name
    
17.             For Each sh In wb.Worksheets
    
18.                 M = M + 1
    
19.                 brr(M, k) = sh.Name
    
20.             Next sh
    
21.             wb.Close False
    
22.         End If
    
23.         Filename = Dir
    
24.     Loop Until Filename = ""
    
25.     Range("B4:G100") = brr
    
26.     MsgBox "提取成功！"
    
27.     Application.DisplayAlerts = True    '表示显示提示和警告消息
    
28.     Application.ScreenUpdating = True    '表求启用屏幕更新
    
29. End Sub

复制代码

zjdh

Sub test()
    Application.DisplayAlerts = False
    Mypath = ThisWorkbook.Path
    Myfile = Dir(Mypath & "\*.xls")
    With ThisWorkbook.Sheets(1)
    .Columns("B:IV").ClearContents
    Do Until Myfile = ""
        If Myfile <> ThisWorkbook.Name Then
            Set WK = Workbooks.Open(Mypath & "\" & Myfile)
            C = .Range("IV4").End(1).Column + 1
            W = 4
            .Cells(W, C) = Myfile
            For Each SH In WK.Sheets
            W = W + 1
            .Cells(W, C) = SH.Name
            Next
            WK.Close True
        End If
        Myfile = Dir
    Loop
    End With
    Application.DisplayAlerts = True
End Sub

zjdh

提取工作表名字.rar (9.91 KB, 下载次数: 6)

2014-9-16 20:43 上传

点击文件名下载附件

张雄友

wp8680 发表于 2014-9-16 20:37

mypath = ThisWorkbook.Path & "\"

能否改成选择文件夹的方式？

张雄友

zjdh 发表于 2014-9-16 20:38
Sub test()
    Application.DisplayAlerts = False
    Mypath = ThisWorkbook.Path

mypath = ThisWorkbook.Path & "\"
能否改成选择文件夹的方式？另外代码只能执行一次，执行多次的话会不断向右生成同样的数据的。不知你发现没有？

zjdh

提取工作表名字.rar (10.64 KB, 下载次数: 27)

2014-9-16 20:53 上传

点击文件名下载附件

wp8680

可以啊，可以改成自己选择文件夹的形式，就是在代码运行时跳出一个对话框，选择路径和对应文件夹。
代码需要改下就可以了。

张雄友

zjdh 发表于 2014-9-16 20:53

            C = .Range("IV4").End(1).Column + 1
            W = 4
            .Cells(W, C) = Myfile
            For Each SH In WK.Sheets
            W = W + 1
            .Cells(W, C) = SH.Name

红色代码，能否直接用 Range 来表达？

zjdh

2个变量的单元格地址，用CELLS来表达是最简洁的！