Word
Excel
PowerPoint
Access
Outlook
ECDL
Poradna - Zjištění počtu odkaů na buňku v sešitu
hlavní kategorie | zpět | + odpovědět na toto téma| Zjištění počtu odkaů na buňku v sešitu - diskuze na toto téma |
| Dostal jsem se k hodně rozsáhlému sešitu, kde dle mého názoru je spousta a zbytečných a duplicitních. Je však možné, že existují nějaké vazby mezi jednotlivými listy, respektive některé buňky jsou součástí vzorců na jiném místě. Existuje nějaký vzorec, který by dokázal dát hodnotu pravda/nepravda podle toho, jestli na danou buňku existuje v dokumentu nějaký odkaz? Případně ještě počet těchto odkazů.
Díky.
PS: Samozřejmě bych to mohl komplet celý prostudovat a najít všechny propojení, ale to bych na tom strávil měsíc. Najjednoduchšie je dať v Možnostiach Excelu zobraziť vzorce.
Alebo na karte Dáta zistiť Prepojenia do iných SUBOROV.
Pripájam makro a výpis vzorcov zo všetkých listov aktuálneho súboru. Stačí po výpise striediť a porovnať duplicity.
Public Sub ListFormulasInWorkbook()
' by J.E. McGimpsey
' revised 04 July 2003 by Tom Ogilvy to add
' sheets when reaching ROWLIM formulas
Const SHEETNAME As String = "Formulas in *"
Const ALLFORMULAS As Integer = _
xlNumbers + xlTextValues + xlLogical + xlErrors
Const ROWLIM As Long = 65500
Dim formulaSht As Worksheet
Dim destRng As Range
Dim cell As Range
Dim wkSht As Worksheet
Dim formulaRng As Range
Dim shCnt As Long
Dim oldScreenUpdating As Boolean
With Application
oldScreenUpdating = .ScreenUpdating
.ScreenUpdating = False
End With
shCnt = 0
ListFormulasAddSheet formulaSht, shCnt
' list formulas on each sheet
Set destRng = formulaSht.Range("A4")
For Each wkSht In ActiveWorkbook.Worksheets
If Not wkSht.Name Like SHEETNAME Then
Application.StatusBar = wkSht.Name
destRng.Value = wkSht.Name
Set destRng = destRng.Offset(1, 0)
On Error Resume Next
Set formulaRng = wkSht.Cells.SpecialCells( _
xlCellTypeFormulas, ALLFORMULAS)
On Error GoTo 0
If formulaRng Is Nothing Then
destRng.Offset(0, 1).Value = "None"
Set destRng = destRng.Offset(1, 0)
Else
For Each cell In formulaRng
With destRng
.Offset(0, 1) = cell.Address(0, 0)
.Offset(0, 2) = "'" & cell.Formula
.Offset(0, 3) = cell.Value
End With
Set destRng = destRng.Offset(1, 0)
If destRng.Row > ROWLIM Then
ListFormulasAddSheet formulaSht, shCnt
Set destRng = formulaSht.Range("A5")
destRng.Offset(-1, 0).Value = wkSht.Name
End If
Next cell
Set formulaRng = Nothing
End If
With destRng.Resize(1, 4).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
Set destRng = destRng.Offset(1, 0)
If destRng.Row > ROWLIM Then
ListFormulasAddSheet formulaSht, shCnt
Set destRng = formulaSht.Range("A5")
destRng.Offset(-1, 0).Value = wkSht.Name
End If
End If
Next wkSht
With Application
.StatusBar = False
.ScreenUpdating = oldScreenUpdating
End With
End Sub
Private Sub ListFormulasAddSheet( _
formulaSht As Worksheet, shtCnt As Long)
Const SHEETNAME As String = "Formulas in "
Const SHEETTITLE As String = "Formulas in $ as of "
Const DATEFORMAT As String = "dd MMM yyyy hh:mm"
Dim shtName As String
With ActiveWorkbook
' Delete existing sheet and create new one
shtCnt = shtCnt + 1
shtName = Left(SHEETNAME & .Name, 28)
If shtCnt > 1 Then _
shtName = shtName & "_" & shtCnt
On Error Resume Next
Application.DisplayAlerts = False
.Worksheets(shtName).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set formulaSht = .Worksheets.Add( _
after:=Sheets(Sheets.Count))
End With
With formulaSht
' Format headers
.Name = shtName
.Columns(1).ColumnWidth = 15
.Columns(2).ColumnWidth = 8
.Columns(3).ColumnWidth = 60
.Columns(4).ColumnWidth = 40
With .Range("C:D")
.Font.Size = 9
.HorizontalAlignment = xlLeft
.EntireColumn.WrapText = True
End With
With .Range("A1")
.Value = Application.Substitute(SHEETTITLE, "$", _
ActiveWorkbook.Name) & Format(Now, DATEFORMAT)
With .Font
.Bold = True
.ColorIndex = 5
.Size = 14
End With
End With
With .Range("A3").Resize(1, 4)
.Value = Array("Sheet", "Address", "Formula", "Value")
With .Font
.ColorIndex = 13
.Bold = True
.Size = 12
End With
.HorizontalAlignment = xlCenter
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = 5
End With
End With
End With
End Sub
Odpověď |
