这个是需要宏的,因为是多目标,而且是无规律的。公式没办法胜任。代码如下
Private Sub updateit_Click()
On Error Resume Next
Dim shtExcel As Object
Dim fs, f, f1, s, sf, m
m = 4
Set fds = CreateObject("Scripting.FileSystemObject")
Set fs = Application.FileSearch
rtdir = InputBox("What is The RootPath you want ? You can get all .XLS files and all sheets list, only if you input the RootPath here and then put the ENTER button! ", "Please enter the RootPath here ! ", Range("B1").Value)
If rtdir = "" Then
Set fds = Nothing
Set fs = Nothing
Exit Sub
End If
If [b1] <> rtdir Then [b1] = rtdir
Application.ScreenUpdating = False
Range("a4:c65536").ClearContents
Sheets(1).[b1].Select
With fs
.LookIn = rtdir
.SearchSubFolders = True
.Filename = "*.xls"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Set fm = fds.GetFile(.FoundFiles(i))
Workbooks.Open .FoundFiles(i), 0
For Each shtExcel In ActiveWorkbook.Sheets
StartF = 1
Do While StartF <> 0
Start = StartF + 1
StartF = InStr(Start, .FoundFiles(i), "\")
Loop
Range("a" & m).Hyperlinks.Add Range("a" & m), fm.parentfolder, , , fm.parentfolder & "\"
Range("b" & m).Hyperlinks.Add Range("b" & m), .FoundFiles(i), , , Right(.FoundFiles(i), Len(.FoundFiles(i)) - Start + 1)
Range("c" & m).Hyperlinks.Add Range("c" & m), .FoundFiles(i), "'" & shtExcel.Name & "'!a1", , shtExcel.Name
m = m + 1
Next
Set shtExcel = Nothing
ActiveWorkbook.Close True
Next i
Else
MsgBox "There were no files found."
End If
End With
Range("A3:C3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("B4") _
, Order2:=xlAscending, Key3:=Range("C4"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal, DataOption3:=xlSortNormal
[b1].Select
Application.ScreenUpdating = True
End Sub
1。你需要链接的目录在一同一个目录下么?
2。链接的目录是否是最底端目录,在下边是否还有目录?
先确定经上回答
然后再告之办法取到你的目录名及路径。
只要取到到了目录名和路径,在EXCEL中用个公式一拉就出来了。
无规则的没办法,除非你先用筛选和分类整理出规律,希望能帮到你
比较难