如何编写代码找出真正的 Circular References(循环引用) 显示该工作表名称及位置

rayhen · 发表于 2023-3-19 22:26

本帖最后由 rayhen 于 2023-3-21 08:56 编辑

显示该循环引用工作表名称及位置

假设有100张工作表,不可能一一寻找吧,而且又在公式中隐藏着,是否有快速方法找出来

不是错误值，#REF！ , #N/A , #NULL , #DIV/0!,#VALUE! .... ETC

任何帮助将不胜感激

liulang0808 · 发表于 2023-3-20 07:43

建议楼主上传附件说明吧

rayhen · 发表于 2023-3-20 08:23

本帖最后由 rayhen 于 2023-3-20 09:09 编辑

谢谢版主 liulang0808 这里只是简单的,如果很多张怎么解

如果一张一张可以这样做公式\错误检查\循环引用
formulas\error checking\circular references

此代码没有反应

Sub FindCircularReferences()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim circulars As Variant
Dim msg As String
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
Set rng = ws.Cells.SpecialCells(xlCellTypeFormulas)
On Error Resume Next
circulars = rng.CircularReference
On Error GoTo 0
If Not IsEmpty(circulars) Then
msg = "Circular reference(s) found on sheet " & ws.Name & ":" & vbCrLf & vbCrLf
For Each cell In circulars
msg = msg & "Cell " & cell.Address(False, False) & vbCrLf
Next cell
MsgBox msg, vbCritical, "Circular Reference Found"
End If
Next ws
Application.ScreenUpdating = True
End Sub

复制代码

liulang0808 · 发表于 2023-3-20 09:07

Sub test()
Dim brr()
str1 = ""
ReDim brr(1 To Sheets.Count)
Application.ScreenUpdating = False
For j = 1 To Sheets.Count
      Set sh = Sheets(j)
      On Error Resume Next
      Set brr(j) = sh.UsedRange.SpecialCells(xlCellTypeFormulas, 16)
      If Not Rng Is Nothing Then
         str1 = str1 & Chr(10) & sh.Name & "的公式报错区域为;" & brr(j).Address(0, 0)
      End If
      If Err.Number <> 0 Then
         On Error GoTo 0
      End If
Next j
If Len(str1) > 0 Then
      MsgBox str1
Else
      MsgBox "无错误值"
End If
Application.ScreenUpdating = True
End Sub

liulang0808 · 发表于 2023-3-20 09:08

找出公式错误值的单元格？不知道理解对不对，供参考

rayhen · 发表于 2023-3-20 09:14

liulang0808 发表于 2023-3-20 09:07
Sub test()
Dim brr()
str1 = ""

版主,那也是一方法, 另外可以找出 SHEET1 的单元格 D8 吗?

niko88819 · 发表于 2023-3-20 16:58

rayhen 发表于 2023-3-20 09:14
版主,那也是一方法, 另外可以找出 SHEET1 的单元格 D8 吗?

是这意思吗?请测试一下

Sub FindCircularReferences()
Dim ws As Worksheet
Dim rng As Range
Dim msg As String
For Each ws In ThisWorkbook.Worksheets
Set rng = ws.CircularReference
If Not rng Is Nothing Then
rng.Parent.Select
rng.Select
msg = "Circular reference found on sheet " & ws.Name & _
" in cell " & rng.Address(0, 0) & _
" with formula: " & vbLf & rng.formula
MsgBox msg, vbCritical, "Circular Reference Found"
End If
Next ws
End Sub

复制代码

rayhen · 发表于 2023-3-21 08:55

niko88819 发表于 2023-3-20 16:58
是这意思吗?请测试一下

老师您超级棒棒棒

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

[已解决] 如何编写代码找出真正的 Circular References(循环引用) 显示该工作表名称及位置

评分

评分