跟踪用户定义范围的依赖关系,并在单独的 sheet 中列出源 Cell/Dependency 单元格

Trace Dependencies for user defined range and list Source Cell/Dependency Cell in separate sheet

我有一系列单元格(用户定义),我希望 vba 告诉我这些单元格链接到哪些单元格。 每个源单元格都可以链接到 1 个或多个单元格。

到目前为止我已经有了代码

我正在努力让每个源单元格水平列出并在依赖单元格下方 2 行。

选项显式 子 ListDependents()

Dim rng As Range
Dim r As Range
Dim cell As Range
Dim n As Long, i As Long

Application.ScreenUpdating = False

'Use InputBox to prompt user for range.
'Test for cancel and a single-cell selection.

Set rng = Application.InputBox( _
    Title:="Please select a range", _
    Prompt:="Select range", _
    Type:=8)

On Error GoTo 0

'Test for cancel.
If rng Is Nothing Then Exit Sub

'Test for single-cell selection.
'Remove comment character if single-cell selection is okay.

If rng.Rows.Count > 1 Then
    MsgBox "You’ve selected more than 1 row. Please select contiguous cells per row only."

End If

'rng.Select to confirm selection
MsgBox rng.Address

'count cells to be reviewed for dependencies
For Each cell In rng.Areas
    n = n + cell.Cells.Count
Next cell

Sheets.Add().Name = "Dependents"

'add first cell of range in B1, second in C1 etc until end of range
'then add first dependent of first range cell in B3, second in C3 etc

If n > "0" Then
  i = 1 + i
   Sheets("Depentent Test").Cells(2, i) =



End Sub

来源Sheet 目的地 Sheet

试试这个。我建议用更有用的变量名替换我的变量名。我没有包括一个单元格是否有任何依赖项的检查,这是可取的,否则它可能会出错。

Sub ListDependents()

Dim rng As Range
Dim r As Range
Dim cell As Range
Dim n As Long, i As Long, j As Long

Application.ScreenUpdating = False

'Use InputBox to prompt user for range.
'Test for cancel and a single-cell selection.

Set rng = Application.InputBox( _
    Title:="Please select a range", _
    Prompt:="Select range", _
    Type:=8)

On Error GoTo 0

'Test for cancel.
If rng Is Nothing Then Exit Sub

'Test for single-cell selection.
'Remove comment character if single-cell selection is okay.

If rng.Rows.Count > 1 Then
    MsgBox "You’ve selected more than 1 row. Please select contiguous cells per row only."
End If

'rng.Select to confirm selection
MsgBox rng.Address

Sheets.Add().Name = "Dependents"

'add first cell of range in B1, second in C1 etc until end of range
'then add first dependent of first range cell in B3, second in C3 etc
Dim ra As Range, r1 As Range, r2 As Range

j = 2
For Each ra In rng.Areas
    For Each r1 In ra
        Cells(1, j) = r1.Address
        i = 3
        For Each r2 In r1.Dependents
            Cells(i, j) = r2.Address
            i = i + 1
        Next r2
        j = j + 1
    Next r1
Next ra
       
End Sub

我找到了在每个依赖项上方添加 header 的解决方案。我将行向下移动了一个 space 以获得 header,然后使用偏移量来匹配相应的 header.

j = 2
For Each ra In rng.Areas
    For Each r1 In ra
       Cells(2, j) = r1.Address
       Cells(1, j) = r1.OffSet(-1, 0).Value
           
    i = 4
    
    For Each r2 In r1.Dependents
                   
       Cells(i, j) = r2.Address
       Cells(i - 1, j) = r2.OffSet(-1, 0).Value
                
        i = i + 2
    Next r2
    j = j + 1
  Next r1
Next ra