Mark einen guten Job gemacht, aber das Makro ging insgesamt nicht auf ‚Beulen im gleichen Blatt und ausgefallen ist, als es noch‘ Beulen aus mehreren Blättern, da die Auswahl kann nicht aus mehreren Blattzellen erstellt werden.
Ich persönlich brauchte alle diese Funktionalität, um die "Strg + [" und "Strg +]" Schnellverknüpfungsfunktionalität für den Sprung zu Präzedenzfälle und Abhängigen zu ersetzen. Leider sind diese Shortcuts auf der internationalen Tastatur völlig unbrauchbar, da diese eckigen Klammern unter der AltGr (rechte Alt) -Kombination verborgen sind und Excel weder Strg + AltGr + 8 noch Strg + AltGr + 8 erlaubt, dasselbe Ergebnis zu erhalten und auch dort keine Möglichkeit, die Standard-Verknüpfungen neu zu ordnen.
Also habe ich den Code von Mark etwas verbessert, um diese Probleme zu beheben und die Popup-Nachricht aus dem Code entfernt, da ich mich selbst wissen sollte, wenn ich nicht alle 'Dellen auswählen kann, aber ich möchte die Funktion reibungslos ohne mich haben Klicken Sie die ganze Zeit auf OK. Die Funktion springt also einfach auf das Blatt, das in der Formel zuerst verknüpft ist.
Ich hoffe, dass dies auch für andere nützlich ist.
Die einzige Sache, die mich noch stört, ist, dass während Application.ScreenUpdating = False verhindert, springt um das Blatt und die Arbeitsmappe, die Pfeile immer noch blinken. Kann ich das vermeiden?
Option Explicit
Private Sub GetOffSheetDents(ByVal doPrecedents As Boolean)
'Main function, calling for separate function to find links to all cells to one of the input cells. Works for finding precedents for a whole selection (group of cells)
'doPrecedents is TRUE, if we are searching for precedents and FALSE, if looking for dependents
Dim InputCell As Range
Dim results As Range
Dim r As Range
Dim sheet As Worksheet
Application.ScreenUpdating = False
For Each InputCell In Application.Intersect(ActiveSheet.UsedRange, Selection)
'Cycle to go over all initially selected cells. If only one cell selected, then happens only once.
Set r = oneCellDependents(InputCell, doPrecedents)
' r is resulting cells from each iteration of input cell to the function.
If Not r Is Nothing Then 'if there were precedents/dependents
If sheet Is Nothing Then 'if this is the first time.
Set sheet = r.Worksheet
Include results, r
ElseIf Not sheet Is r.Worksheet Then 'if new precedent/dependent is on another worksheet, don't add to selection (gets lost)
Else
Include results, r
End If
End If
Next
Application.ScreenUpdating = True
If results Is Nothing Then
Beep
Else
results.Worksheet.Activate
results.Select
End If
End Sub
Sub GetOffSheetDependents()
'Function defines, if we are looking for Dependents (False) or Precedents (True)
GetOffSheetDents False
End Sub
Sub GetOffSheetPrecedents()
'Function defines, if we are looking for Dependents (False) or Precedents (True)
GetOffSheetDents True
End Sub
Private Function Include(ByRef ToUnion As Range, ByVal Value As Range) As Range
If ToUnion Is Nothing Then
Set ToUnion = Value
ElseIf Value.Worksheet Is ToUnion.Worksheet Then 'if new precedent/dependent is on the same worksheet, then add to selection
'if new precedent/dependent is on another worksheet, don't add to selection (gets lost)
Set ToUnion = Application.Union(ToUnion, Value)
End If
Set Include = ToUnion
End Function
Private Function oneCellDependents(ByVal inRange As Range, Optional doPrecedents As Boolean) As Range
'Function finds dependents for one of the selected cells. Happens only once, if initially only one cell selected.
Dim inAddress As String, returnSelection As Range
Dim i As Long, pCount As Long, qCount As Long
Application.ScreenUpdating = False
If inRange.Cells.Count <> 1 Then Error.Raise 13 'seems to check, that only one cell is handled, but does not seem to be necessary step.
'remember selection
Set returnSelection = Selection ' to keep initial selection for GetOffSheetDents function.
inAddress = fullAddress(inRange) ' takes address of starting cell what is analyzed.
pCount = 1
With inRange 'all functions apply to this initial cell.
.ShowPrecedents
.ShowDependents
.NavigateArrow doPrecedents, 1 ' go to first precedent (if first argument is true)/dependent. But why required?
Do Until fullAddress(ActiveCell) = inAddress
.NavigateArrow doPrecedents, pCount 'go to first precedent, then second etc.
If ActiveSheet.Name <> returnSelection.Parent.Name Then ' checks, if the precedent is NOT on the same sheet
Do
qCount = qCount + 1 'qCount follows external references, if arrow is external reference arrow.
.NavigateArrow doPrecedents, pCount, qCount 'go to first exteranl precedent, then second etc.
Include oneCellDependents, Selection
On Error Resume Next
.NavigateArrow doPrecedents, pCount, qCount + 1 'could remove this step and check for error before Include?
If Err.Number <> 0 Then Exit Do
On Error GoTo 0 ' not sure if this is used, since if there is error, then already Exit Do in previous step.
Loop
On Error GoTo 0 'not sure, if necessary, since just asked in loop.
Else ' if precedent IS ON the same sheet.
Include oneCellDependents, Selection
End If
pCount = pCount + 1
.NavigateArrow doPrecedents, pCount
Loop
.Parent.ClearArrows
End With
'return selection to where it was
With returnSelection
.Parent.Activate
.Select
End With
End Function
Private Function fullAddress(inRange As Range) As String
'Function takes a full address with sheet name
With inRange
fullAddress = .Parent.Name & "!" & .Address
End With
End Function
+1, wie Sie eine bessere allgemeine Lösung für ein größeres Problem haben, als ich hatte, aber ich habe das grüne Häkchen nicht eingeschaltet, weil ich wissen will _do_, wenn ich nicht alle ‚Beulen gesehen habe. –
In Ihren hinzugefügten Kommentaren fragen Sie nach 'On Error GoTo 0'. Dadurch wird die Fehlermeldung "On Error Resume Next" deaktiviert, und Sie müssen feststellen, ob ein Fehler vorliegt oder nicht, also an zwei Stellen. –
Und der 'inRange.Cells.Count <> 1' Check ist nur defensive Programmierung. –