Come trovare tutte le celle dipendenti al di fuori del foglio e della cartella di lavoro in VBA?

SOLUZIONE

Il codice macro VBA trova tutte le celle dipendenti della cella attiva (cella selezionata) e visualizza il loro indirizzo completo in una finestra di messaggio. Questa macro mostra tutte le celle dipendenti, incluse quelle che sono al di fuori del foglio di lavoro e della cartella di lavoro correnti. La chiave per la soluzione è utilizzare il metodo “Range.Navigatearrow” per passare attraverso le celle dipendenti (la funzione è anche in grado di passare attraverso le celle precedenti, ma quell’argomento è per un altro articolo).

L’intero codice è diviso in 3 parti:

  1. La Sub principale (la macro che devi eseguire): la procedura ‘messageBoxCellDependents‘ prende la cella selezionata come input e chiama la funzione ‘findDepend‘ e visualizza ciò che viene restituito dalla funzione findDepend.
  2. Funzione – fullAddress (chiamata nella Sub principale): la funzione ‘fullAddress‘ restituisce l’indirizzo completo della cella data insieme al nome della cartella di lavoro e del foglio. Ad esempio: [Cartel1]Foglio1!$A$1 è l’indirizzo completo di Range(“A1”).
  3. Funzione – findDepend (chiamata nella Sub principale e in cui si svolge tutta l’azione): la funzione ‘findDepend‘ restituisce tutte le celle dipendenti come stringa, comprese le celle al di fuori della cartella di lavoro attiva. Componenti chiave di findDepend:
    • La proprietà Range.Navigatearrow può essere utilizzata per esplorare le dipendenti/precedenti dell’intervallo in base al valore del primo argomento. Se il primo argomento è ‘False’ (vedi il codice seguente), naviga attraverso le celle dipendenti.
    • La variabile pCount viene utilizzata per fare riferimento alle celle all’interno del foglio di lavoro corrente.
    • La variabile qCount viene utilizzata per fare riferimento alle celle al di fuori del foglio/cartella di lavoro corrente.

BUG CONOSCIUTI

Excel 2010: in alcune versioni di Excel, il metodo Navigatearrow avrà problemi a navigare attraverso tutte le celle dipendenti se ci sono celle al di fuori della cartella di lavoro o del foglio di lavoro corrente. L’unica soluzione è far girare il codice VBA su un altro foglio di lavoro prima di procedere con il ciclo delle celle dipendenti. Non siamo sicuri del motivo per cui appare questo bug. Alcune installazioni di Excel 2010 non presentano questo problema.

CODICE MACRO VBA 

Questo è un codice di prova per mostrare che la funzione findDepend funziona. Per il codice VBA effettivo, potrebbe essere necessario modificare il codice per far sì che la funzione restituisca un elenco di celle, invece di mostrare gli indirizzi di cella in una finestra pop-up.

 
Sub messageBoxCellDependents()
    Dim SelRange As Range
    Set SelRange = Selection
    MsgBox findDepend(SelRange) 'mostra le celle dipendenti in una finestra pop up
End Sub

Function fullAddress(inCell As Range) As String
    fullAddress = inCell.Address(External:=True)
End Function

Function findDepend(ByVal inRange As Range) As String
    Dim sheetIdx As Integer
    sheetIdx = Sheets(inRange.Parent.Name).Index
    
    If sheetIdx = Worksheets.Count Then 'per aggirare il bug vba
        Sheets(sheetIdx - 1).Activate
    Else
        Sheets(Worksheets.Count).Activate
    End If

    Dim inAddress As String, returnSelection As Range
    Dim i As Long, pCount As Long, qCount As Long
    Set returnSelection = Selection
    inAddress = fullAddress(inRange)
    
    Application.ScreenUpdating = False
    With inRange
        .ShowPrecedents
        .ShowDependents
        .NavigateArrow False, 1
        Do Until fullAddress(ActiveCell) = inAddress
            pCount = pCount + 1
            .NavigateArrow False, pCount
            If ActiveSheet.Name <> returnSelection.Parent.Name Then
                Do
                    qCount = qCount + 1
                    .NavigateArrow False, pCount, qCount
                    findDepend = findDepend & fullAddress(Selection) & Chr(13)
                    
                    On Error Resume Next
                    .NavigateArrow False, pCount, qCount + 1
                Loop Until Err.Number <> 0
                .NavigateArrow False, pCount + 1
            Else
                findDepend = findDepend & fullAddress(Selection) & Chr(13)
                
                .NavigateArrow False, pCount + 1
            End If
        Loop
        .Parent.ClearArrows
    End With
    
    With returnSelection
        .Parent.Activate
        .Select
    End With
    
    Sheets(sheetIdx).Activate 'attiva il foglio di lavoro iniziale
End Function

 

Tags: , , , , , , , , , , ,

Ti è stato utile?