如何在大批文件中找到有链接的文件表格

125675117 · 发表于 2022-3-28 09:21

本帖最后由 125675117 于 2022-3-29 10:07 编辑

在半百老师针对我的问题提出了解决方案（请见下面代码）：目前该只能识别当前所在文件夹内的excel文件的链接。我现在又有新的想法，希望能在半百老师的代码基础上增加：包含子目录下所有excel文件都可识别。请老师帮助修改代码，谢谢。同时我自己摸索着修改了在A列体现文件名，B列体现对应表格名，C列体现链接所在单元格。附件我已经更新。

Sub 查找()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False '关闭程序询问更新链接提示
P = ThisWorkbook.Path & ""
F = Dir(P & "*.XLS*") '获取当前目录下的excel文件
Do While F <> ""
If F <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(P & F)
For Each sh In wb.Sheets
Dim fname As String
fname = ThisWorkbook.Name
fname = ActiveSheet.Name
Set Rng = sh.Cells.Find("*:\*")
If Not Rng Is Nothing Then
s = Rng.Address
Do
n = n + 1
ThisWorkbook.Sheets(1).Cells(n, 1) = F
'ThisWorkbook.Sheets(1).Cells(n, 2) = F & "!" & s
ThisWorkbook.Sheets(1).Cells(n, 2) = fname
ThisWorkbook.Sheets(1).Cells(n, 3) = s
Set Rng = sh.Cells.FindNext(Rng)
Loop While s <> Rng.Address
End If
Next
wb.Close
End If
F = Dir
Loop
MsgBox "查找完毕！"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ThisWorkbook.UpdateLinks = xlUpdateLinksAlways '更新链接
End Sub

复制代码

最早的问题：有一大批表格文件，有些文件中的部分单元格因为错误的复制，导致有些表格出现了绝对引用的链接，请见附件工作簿：表格1 - 副本 (1) 1 表中B5出现链接，工作簿：表格1 - 副本 (3) 表3 A21出现链接，能不能用VBA实现将有链接的文件名及出现链接的位置统计在一张表格里，方便去手动修改。

125675117 · 发表于 2022-3-28 11:02

别沉下去了，我自己顶一下。期待大神帮助

半百 · 发表于 2022-3-28 13:46

Sub 查找()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
P = ThisWorkbook.Path & "\"
F = Dir(P & "*.XLS*")
Do While F <> ""
If F <> ThisWorkbook.Name Then
      Set WB = Workbooks.Open(P & F)
      For Each SH In WB.Sheets
         Set Rng = SH.Cells.Find("*\*")
         If Not Rng Is Nothing Then
            S = Rng.Address
            Do
                  N = N + 1
                  ThisWorkbook.Sheets(1).Cells(N, 1) = F & "!" & S
                  Set Rng = SH.Cells.FindNext(Rng)
            Loop While S <> Rng.Address
         End If
      Next
      WB.Close
End If
F = Dir
Loop
MsgBox "查找完毕！"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

ＥＸＣＥＬ小子 · 发表于 2022-3-28 14:06

Sub myFind(sh As Worksheet, sht As Worksheet)
Dim rg As Range, s As String, n As Long
Set rg = Range("a:f").Find("xls", LookIn:=xlFormulas)
If Not rg Is Nothing Then
s = rg.Address
Do
Debug.Print rg.Address
n = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row + 1
sht.Cells(n, 1) = "'" & rg.Formula
sht.Cells(n, 2) = rg.Address(0, 0)
Set rg = Range("a:f").FindNext(rg)
Loop While Not rg Is Nothing And rg.Address <> s
End If
End Sub
Sub folder_dialog()
Dim folder_path As String
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ThisWorkbook.Path & ""
If .Show = -1 Then
folder_path = .SelectedItems(1) & ""
Debug.Print folder_path
foreach_folder folder_path
End If
End With
Application.ScreenUpdating = True
End Sub
Sub foreach_folder(folder_p As String)
Dim wk As Workbook, ss As Worksheet, ac As Worksheet
Dim st As String ', a As Integer
Set ac = ActiveSheet
st = Dir(folder_p & "*.xls*")
Application.ScreenUpdating = False
Do While st <> ""
Set wk = Workbooks.Open(folder_p & st)
For Each ss In wk.Worksheets
myFind ss, ac
Next ss
wk.Close False
Debug.Print st
st = Dir
Loop
Application.ScreenUpdating = True
End Sub

复制代码

125675117 · 发表于 2022-3-28 15:21

半百发表于 2022-3-28 13:46
Sub 查找()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

好用，非常好用，谢谢。

125675117 · 发表于 2022-3-28 15:25

半百发表于 2022-3-28 13:46
Sub 查找()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

老师，目前只能识别当前所在文件夹内的excel文件的链接，能不能改成包含子目录下所有excel文件都可识别，并且在A列体现文件名，B列体现对应表格名，C列体现链接所在单元格，如果一张表有多个链接，就依次往下填行就是

125675117 · 发表于 2022-3-28 15:27

ＥＸＣＥＬ小子发表于 2022-3-28 14:06

老师，我不会用这个代码，复制进去用不了呢？

ＥＸＣＥＬ小子 · 发表于 2022-3-28 15:35

folder_dialog
执行该过程

125675117 · 发表于 2022-3-28 15:51

ＥＸＣＥＬ小子发表于 2022-3-28 15:35
folder_dialog
执行该过程

是默认也是执行folder_dialog过程，但是选择文件夹后，没有任何结果

125675117 · 发表于 2022-3-28 16:10

ＥＸＣＥＬ小子发表于 2022-3-28 15:35
folder_dialog
执行该过程

我是执行的这个过程，但是执行后选择了文件夹后，就没有结果了

		自动登录	找回密码
密码			免费注册

[求助] 如何在大批文件中找到有链接的文件表格