Найдите на листе Excel, какие ячейки ссылаются на другие листы - PullRequest
Новая
       56

Найдите на листе Excel, какие ячейки ссылаются на другие листы

0 голосов
/ 06 августа 2020

Мне нужно найти их и заменить формулу на его значение.

В настоящее время я ищу !, но я думаю, что он не очень чистый.

! может быть используется внутри формулы без ссылки на другие листы, например: =IF(A1<0; "Be careful A1 is negative!"; "OK");

Проверка, появляется ли ! перед ", не кажется окончательным решением, например: =IF(A1<0; "Be careful A1 is negative!"; Sheet2!A1+2);

ОБНОВЛЕНИЕ: Помимо того, что объяснено выше, следует также учитывать именованные диапазоны. Они могли ссылаться на другие листы без использования !.

Ответы [ 2 ]

2 голосов
/ 06 августа 2020

Вы можете использовать Regex, чтобы найти ссылку в формуле на другой лист: 

Option Explicit

Function GetFormulaReference(sFormula As String) As String
    Dim sPattern As String, sRng As String
    Dim oRegex As RegExp, oMatches As Object, oMatch As Object
        
    Debug.Print sFormula
    sPattern = "\w+!\w{1,}\d{1,}"
    Set oRegex = New RegExp
    With oRegex
        .Pattern = sPattern
        Set oMatches = .Execute(sFormula)
        For Each oMatch In oMatches
            sRng = oMatch
        Next
    End With
    Set oMatch = Nothing
    Set oMatches = Nothing
    Set oRegex = Nothing
    
    GetFormulaReference = sRng
    
End Function

Использование: 

Sub Test()
    Dim sRng As String
    
    sRng = GetFormulaReference("=IF(A1<0; ""Be careful A1 is negative!""; ""Sheet2!A1+2"");")
    Debug.Print "Address: = '" & sRng & "'"
    sRng = GetFormulaReference("=IF(A1<0; ""Be careful A1 is negative!""; ""OK"");")
    Debug.Print "Address: = '" & sRng & "'"

End Sub

Результат: 

=IF(A1<0; "Be careful A1 is negative!"; "Sheet2!A1+2");
Address: = 'Sheet2!A1'
=IF(A1<0; "Be careful A1 is negative!"; "OK");
Address: = ''

Примечание №1: вам необходимо добавить ссылку на Microsoft VBScript Regular Expressions 5.5 Примечание №2: шаблон выше будет работать для стиля A1 адресации, но не для R1C1!

reference

Final note: If GetFormulaReference function returns empty string, then there's no reference to another sheet.

[EDIT]

For именованных диапазонов , вы можете использовать что-то вроде этого: 

Function GetNamedRangeReference(sFormula) As String
    Dim nms As Object, sName As String, sRetVal As String
    Set nms = ActiveWorkbook.Names 
    For i = 1 To nms.Count 
        sName = nms(r).Name 
        If InStr(1, sFormula, sName, vbTextCompare)>0 Then sRetVal =  nms(r).RefersToRange.Address 'return address instead of name
    Next

    GetNamedRangeReference = sRetVal

End Function

Примечание: Я не тестировал вышеуказанную функцию.

Удачи!

2 голосов
/ 06 августа 2020

Попробуйте следующий код, пожалуйста: 

Sub testOtherSheetsRef()
  Dim sh As Worksheet, rngF As Range, C As Range
  Set sh = ActiveSheet
  Set rngF = sh.UsedRange.SpecialCells(xlCellTypeFormulas)
  For Each C In rngF
    If InStr(C.Formula, "!") > 0 Then
        If InStr(C.Formula, " !") = 0 And _
            InStr(C.Formula, "! ") = 0 And _
            InStr(C.Formula, "!""") = 0 Then
            Debug.Print C.Address & " is referencing another sheet..."
        End If
    End If
  Next
End Sub
...