externe Verknüpfungen finden

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Verknuepfungen_Suchen() 'Sucht in der aktiven Arbeitsmappe nach externen Formeln und schreibt diese in ein neues 'Arbeitsblatt; sinnvoll, wenn man in einer Arbeitsmappe nach unbekannten Verknüpfungen sucht Dim s As Object For Each s In Sheets s.Visible = True Next ws = ActiveWorkbook.Worksheets.Count For c = 1 To ws Sheets(c).Select n = ActiveSheet.Name n2 = "Formeln_" & n FIndex = False z = 2 Set r1 = Range("a1", Range("a1").SpecialCells(xlLastCell)) For Each a In r1.Cells If a.HasFormula Then If InStr(a.Formula, "[") > 0 Then If FIndex = False Then Worksheets.Add after:=Sheets(n) ActiveSheet.Name = n2 Kopf = Array("Zelle", "Zeile", "Spalte", "Formel") For t = 1 To 4 Cells(1, t) = Kopf(t - 1) Cells(1, t).Font.Bold = True Next t FIndex = True End If Sheets(n2).Cells(z, 1) = a.Address(rowabsolute:=False, columnabsolute:=False) Sheets(n2).Cells(z, 2) = a.Row Sheets(n2).Cells(z, 3) = a.Column Sheets(n2).Cells(z, 4) = "'" & a.Formula z = z + 1 End If End If Next a Columns("A:D").EntireColumn.AutoFit Range("A1").Select Next c End Sub

hallo,
probier mal diesen code, ob er das bringt,was du willst
gruß
rofu


Sub ZeigeVerknuepfungen()
Dim Tab1 As Object
Dim Zelle1 As Object
Dim AlleFormeln As Object
Dim NeuesBlatt As Worksheet
Dim Zeile As Integer
On Error GoTo 0
Set NeuesBlatt = ActiveWorkbook.Worksheets.Add(ActiveWorkbook.Worksheets(1))
On Error Resume Next
NeuesBlatt.Name = "Externe Verknüpfungen"
NeuesBlatt.Range("a3").Formula = "Arbeitsblatt"
NeuesBlatt.Range("b3").Formula = "Zelle"
NeuesBlatt.Range("c3").Formula = "Externer Bezug"
NeuesBlatt.Range("d3").Formula = "Aktueller Wert"
NeuesBlatt.Range("a1").Font.Bold = True
NeuesBlatt.Range("a3:d3").Font.Bold = True
Zeile = 4
Application.ScreenUpdating = False
For Each Tab1 In ActiveWorkbook.Worksheets
If Tab1.Name  NeuesBlatt.Name Then
Set AlleFormeln = Nothing
Set AlleFormeln = Tab1.Cells.SpecialCells(xlFormulas, 23)
'MsgBox (AlleFormeln)
If AlleFormeln Then
For Each Zelle1 In AlleFormeln
If InStr(Zelle1.Formula, "\") > 0 Then
'MsgBox (Zelle1)
'If Tab1.Name  NeuesBlatt.Name Then
NeuesBlatt.Cells(Zeile, 1).Formula = Tab1.Name
NeuesBlatt.Cells(Zeile, 2).Formula = Zelle1.AddressLocal(False, False)
NeuesBlatt.Cells(Zeile, 3).Formula = Right$(Zelle1.FormulaLocal, Len(Zelle1. _
FormulaLocal) - 2)
NeuesBlatt.Cells(Zeile, 4).Formula = Zelle1.Value
Zeile = Zeile + 1
'End If
'                If Zelle1.HasArray Then
'                    Zelle1.CurrentArray.Select
'                    Selection.Copy
'                    Selection.PasteSpecial Paste:=xlValues
'                    Application.CutCopyMode = False
'                Else
'                    Zelle1.Formula = Zelle1.Value
'                End If
End If
Next Zelle1
End If
End If
Next Tab1
FormatiereDenRest:
For Zeile = 1 To 4
NeuesBlatt.Cells(1, Zeile).EntireColumn.AutoFit
Next
NeuesBlatt.Range("a1").Formula = "Externe Verknüpfungen in " + UCase$(ActiveWorkbook.Name)
On Error GoTo 0
'Aufräumen der Tabelle
Zeile = 4
While NeuesBlatt.Cells(Zeile, 1).Text  ""
If NeuesBlatt.Cells(Zeile, 2).Text = "" Then
NeuesBlatt.Cells(Zeile, 2).EntireRow.Delete
Else
Zeile = Zeile + 1
End If
Wend
Application.ScreenUpdating = True
If Zeile = 4 Then
a = MsgBox("Keine externen Verknüpfungen gefunden", vbOKOnly, "Keine Verknüpfungen")
Application.DisplayAlerts = False
NeuesBlatt.Delete
Application.DisplayAlerts = True
End If
Application.ScreenUpdating = True
Exit Sub
FehlerVerknüpfungAuflösen:
If Err = 1004 Then Resume Next Else MsgBox ("Keine Zellen mit externen Verknüpfungen  _
gefunden")
GoTo FormatiereDenRest
End Sub

Option Explicit Sub Verknüpfte_Zellen() ' Verknüpfungen auflisten ' nach'* H. Ziplies '* 22.08.03, 24.04.04; 31.07.05; 18.10.05 '* erstellt von Hajo.Ziplies@web.de '* http://home.media-n.de/ziplies/ ' geänd. von Erich G. 20.07.2008 Dim RaZelle As Range, ByMldg As Integer, Sh As Worksheet Dim namN As Name, zz As Long For Each Sh In Worksheets If Sh.Name = "Verknüpfungen" Then ByMldg = MsgBox("Tabelle Verknüfungen schon vorhanden - Löschen?", _ vbYesNo + vbQuestion, "Löschabfrage ?", "", 0) If ByMldg 6 Then Exit Sub Sh.Cells.Clear Exit For End If Next Sh If ByMldg 6 Then _ Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Verknüpfungen" zz = 1 Cells(zz, 1) = "Zelle" Cells(zz, 2) = "Tabelle" Cells(zz, 3) = "Formel" For Each Sh In Worksheets If Sh.Name "Verknüpfungen" Then ' Sh.Unprotect ' .unprotect "Passwort" For Each RaZelle In Sh.UsedRange If RaZelle.HasFormula And InStr(RaZelle.Formula, ":\") > 1 Then zz = zz + 1 Cells(zz, 1) = RaZelle.Address(0, 0) Cells(zz, 2) = Sh.Name Cells(zz, 3) = "'" & RaZelle.Formula End If Next RaZelle ' Sh.Protect ' .Protect "Passwort" End If Next Sh ' ------------------------------------------------------------ Namen zz = zz + 3 Cells(zz, 1) = "Name" Cells(zz, 2) = "Bezug" For Each namN In ActiveWorkbook.Names zz = zz + 1 Cells(zz, 1) = namN.Name With Cells(zz, 2) If InStr(namN, "REF") 0 Then .Value = namN '"Fehlerhaft" .Font.Bold = True .Font.ColorIndex = 3 ElseIf InStr(namN, "\") 0 Then .Value = namN .Font.Bold = True .Font.ColorIndex = 4 Else .Value = Mid(namN, 2) End If End With Next End Sub

Mist, hatte meine Nachricht an der falschen Stelle platziert. Hier also nochmal!!!
Also, ihr seid alle genial.
Lieber Ron,
das Makro funktioniert einwandfrei. Klasse, vielen Dank!
lieber Erich,
vielen Dank, aber das mit den Namen hatte ich ja schon geklärt, da war ja nix.
Ansonsten: JAAAAAAAAAAAAAAAAAAAA, warum kommt man nie auf das Naheliegende?
Klar: Suchfunktion!!!!! Wald und Bäume? Excelmania?
Das Makro hatte hier aber folgenden Vorteil: Man konnte auf einen Blick die Felder mit den Verknüpfungen sehen. Hätte ich mich der Suchfunktion begonnen, hätte ich unter Umständen oft klicken können, bis ich alles gefunden hätte.
Das mit den Bearbeiten-Verknüpfungen-Quelle löschen: Ja klar, aber ich lese doch lieber vorher, WAS ich da so lösche und ändere ;-)
Jedenfalls: Betrachtet euch alle mal als geknuddelt!!!! ;-))))
Liebe Grüße
Susanne

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

59 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

externe Verknüpfungen finden

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

59 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread