Question

根据Excel，我找不到无效的命名范围或引用。我检查了我的命名范围，包括图表内的范围。 excel文件包含一个宏，该宏可以创建一个在文件本身中启动时可以正常工作的报告。但是，如果我从另一个工作簿中调用该函数来运行报表，即当我收到无效引用的错误消息时。查看直接或间接创建的报告时，它们看起来是相同的。设置Application.DisplayAlerts = False不起作用。

我尝试使用来自Allen Wyatt的以下代码来遍历所有参考，没有参考外部工作表，也没有包含任何错误。

    Sub CheckReferences()
    ' Check for possible missing or erroneous links in
    ' formulas and list possible errors in a summary sheet

      Dim iSh As Integer
      Dim sShName As String
      Dim sht As Worksheet
      Dim c, sChar As String
      Dim rng As Range
      Dim i As Integer, j As Integer
      Dim wks As Worksheet
      Dim sChr As String, addr As String
      Dim sFormula As String, scVal As String
      Dim lNewRow As Long
      Dim vHeaders

      vHeaders = Array("Sheet Name", "Cell", "Cell Value", "Formula")
      'check if 'Summary' worksheet is in workbook
      'and if so, delete it
      With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
      End With

      For i = 1 To Worksheets.Count
        If Worksheets(i).Name = "Summary" Then
          Worksheets(i).Delete
        End If
      Next i

      iSh = Worksheets.Count

      'create a new summary sheet
        Sheets.Add After:=Sheets(iSh)
        Sheets(Sheets.Count).Name = "Summary"
      With Sheets("Summary")
        Range("A1:D1") = vHeaders
      End With
      lNewRow = 2

      ' this will not work if the sheet is protected,
      ' assume that sheet should not be changed; so ignore it
      On Error Resume Next

      For i = 1 To iSh
        sShName = Worksheets(i).Name
        Application.Goto Sheets(sShName).Cells(1, 1)
        Set rng = Cells.SpecialCells(xlCellTypeFormulas, 23)

        For Each c In rng
          addr = c.Address
          sFormula = c.Formula
          scVal = c.Text

          For j = 1 To Len(c.Formula)
            sChr = Mid(c.Formula, j, 1)

            If sChr = "[" Or sChr = "!" Or _
              IsError(c) Then
              'write values to summary sheet
              With Sheets("Summary")
                .Cells(lNewRow, 1) = sShName
                .Cells(lNewRow, 2) = addr
                .Cells(lNewRow, 3) = scVal
                .Cells(lNewRow, 4) = "'" & sFormula
              End With
              lNewRow = lNewRow + 1
              Exit For
            End If
          Next j
        Next c
      Next i

    ' housekeeping
      With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
      End With

    ' tidy up
      Sheets("Summary").Select
      Columns("A:D").EntireColumn.AutoFit
      Range("A1:D1").Font.Bold = True
      Range("A2").Select
    End Sub

Answer 1

尝试一下，我更改了一些可能解决您问题的方法：

1：防止内存泄漏：

Set wks = Nothing
Set sht = Nothing
Set rng = Nothing

2：在循环的顶部包含一个DoEvents语句。这基本上可以告诉PC查看Windows和任何其他应用程序是否有任何处理要做，并允许它们执行此操作，以便Excel不会占用CPU的100％，这可以冻结计算机，直到宏循环出现为止完成。

3：

Dim c As Variant
Dim sChar As String

4：链接到一个单元格

vHeaders = Array("Sheet Name", "Cell", "Link", "Cell Value", "Formula")
....
With Sheets("Summary")
.Cells(lNewRow, 1) = sShName
.Cells(lNewRow, 2) = addr
.Cells(lNewRow, 3).FormulaR1C1 = "=HYPERLINK(""#""&RC[-2]&""!""&RC[-1],""GO!"")"
.Cells(lNewRow, 4) = scVal
.Cells(lNewRow, 5) = "'" & sFormula
End With
.....

5： Todo （如果需要）：在循环的底部添加Set rng = Nothing，并在其顶部进行检查，因为它会错误地报告在没有任何时间的工作表上的公式上一张有一些。

      Sub CheckReferences()
' Check for possible missing or erroneous links in
' formulas and list possible errors in a summary sheet

  Dim iSh As Integer
  Dim sShName As String
  Dim sht As Worksheet
  Dim c As Variant
  Dim sChar As String
  Dim rng As Range
  Dim i As Integer, j As Integer
  Dim wks As Worksheet
  Dim sChr As String, addr As String
  Dim sFormula As String, scVal As String
  Dim lNewRow As Long
  Dim vHeaders

  vHeaders = Array("Sheet Name", "Cell", "Link", "Cell Value", "Formula")
  'check if 'Summary' worksheet is in workbook
  'and if so, delete it
  With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
  End With

  For i = 1 To Worksheets.Count
    If Worksheets(i).Name = "Summary" Then
      Worksheets(i).Delete
    End If
  Next i

    iSh = Sheets.Count
    'create a new summary sheet
    Sheets.Add After:=Sheets(iSh)
    Sheets(Sheets.Count).Name = "Summary"
  With Sheets("Summary")
    Range("A1:D1") = vHeaders
  End With
  lNewRow = 2

  ' this will not work if the sheet is protected,
  ' assume that sheet should not be changed; so ignore it


  For i = 1 To iSh
  DoEvents
    sShName = Worksheets(i).Name
    Application.Goto Sheets(sShName).Cells(1, 1)

     On Error Resume Next
       Range("A1:A" & Range("A" & Cells.Rows.Count).End(xlUp).Row).Resize(, 6).SpecialCells(xlCellTypeBlanks).Value = 0
     On Error GoTo 0

     On Error Resume Next
        Set rng = Range("A1:D5000").SpecialCells(xlCellTypeFormulas, 23)
     On Error GoTo 0




   ' Set rng = ActiveSheet.Cells.SpecialCells(Type:=xlCellTypeFormulas, Value:=23)

    For Each c In rng
    DoEvents
      addr = c.Address
      sFormula = c.Formula
      scVal = c.Text

      For j = 1 To Len(c.Formula)
      DoEvents
        sChr = Mid(c.Formula, j, 1)

        If sChr = "[" Or sChr = "!" Or _
          IsError(c) Then
          'write values to summary sheet
          With Sheets("Summary")
           .Cells(lNewRow, 1) = sShName
           .Cells(lNewRow, 2) = addr
           .Cells(lNewRow, 3).FormulaR1C1 = "=HYPERLINK(""#""&RC[-2]&""!""&RC[-1],""GO!"")"
           .Cells(lNewRow, 4) = scVal
           .Cells(lNewRow, 5) = "'" & sFormula
           End With
          lNewRow = lNewRow + 1
          Exit For
        End If
      Next j
    Next c
  Next i

' housekeeping
  With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic
  End With

' tidy up
  Sheets("Summary").Select
  Columns("A:D").EntireColumn.AutoFit
  Range("A1:D1").Font.Bold = True
  Range("A2").Select


 Set wks = Nothing
 Set sht = Nothing
 Set rng = Nothing
End Sub

希望能解决您的问题

**注意：**如果您使用Excel 2016，请尝试使用FINDLINK插件，您将获得时间;）这样做与宏相同。

Excel错误消息“一个或多个命名无效引用”

1 个答案: