Question

有没有办法使用VBA列出公式引用的所有行？

我已经构建了一个只应引用同一行中的单元格的电子表格，并且引用不同行的任何公式都是错误的。我无法解决如何在VBA中执行此操作。例如，第三个公式会出错。

=(D3+F3)/(E3+D3)
=D4/E4
=D5^E5+F12
=D6+F6^G6

Answer 1

好的，我可以理解你想检查公式是否只引用单行的原因......

这是我写的。请阅读代码中的评论。

Option Explicit

Sub CheckFormulas()
Dim c As Range
Dim wsh As Worksheet
Dim sformula As String

'context
Set wsh = ThisWorkbook.Worksheets(1)
'loop through the set of cells in UsedRange
For Each c In wsh.UsedRange
    'formula starts with "="
    If c.Formula Like "=*" Then
        sformula = c.Formula
        'check if formula refer to single row
        'if not, change background color form this cell
        If DoesFormulaReferToSingleRow(sformula) Then
            c.Interior.Color = vbRed
        End If
    End If
Next

End Sub

'needs reference to MS VBScript Regular Expression 5.5
'           MS Scripting RunTime
Function DoesFormulaReferToSingleRow(sFormulaToCheck As String) As Boolean
Dim bRetVal As Boolean, sPattern As String
Dim re As VBScript_RegExp_55.RegExp, mc As VBScript_RegExp_55.MatchCollection, m As VBScript_RegExp_55.Match
Dim oDict As Scripting.Dictionary

bRetVal = False

sPattern = "\d{1,}"

Set re = New VBScript_RegExp_55.RegExp
With re
    .Global = True
    .MultiLine = False
    .Pattern = sPattern
    Set mc = .Execute(sFormulaToCheck)
End With

Set oDict = New Scripting.Dictionary

For Each m In mc
    If Not oDict.Exists(m.Value) Then
        oDict.Add m.Value, m.Length
    End If
Next

bRetVal = Not (oDict.Count = 1)

Exit_DoesFormulaReferToSingleRow
    On Error Resume Next
    Set m = Nothing
    Set mc = Nothing
    Set re = Nothing
    Set oDict = Nothing
    DoesFormulaReferToSingleRow = bRetVal
    Exit Function

Err_DoesFormulaReferToSingleRow:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_DoesFormulaReferToSingleRow
End Function

如您所见，我使用了Regex和Dictionary对象。不要使用formget来添加引用。

有关上述对象的详细信息，请参阅：
Regex - syntax
Creating a Regular Expression
Microsoft Beefs Up VBScript with Regular Expressions

检查公式在Excel中引用的行（使用VBA进行错误检查）

1 个答案: