holst Du vielleicht Daten aus einer zweiten Tabelle? Dann "Ja" klicken.
lg
Marcus
Wissen ist Macht - es ist aber nicht schlimm nicht alles zu wissen.
Man muss nicht alles wissen - man muss nur wissen wo es steht, oder wo man Hilfe bekommt.
Auch wenn ich nein klicke kommt das ab und zu wieder, deswegen wollte ich wissen wo ich sehen kann um was es sich handelt.
Zum Hintergrund:
Das ist eine passwortgeschützte Tabelle und hab daraus ein Tabellenblatt mal kopiert und dort hab ich das Passwort und den Blattschutz aufgehoben.
Aber seit dem kommt immer diese Meldung.
mit diesem Code von Hajo kannst du feststellen ob es (unerwünschte) externe Verknüpfungen, z.B. Formeln, zu einer anderen Datei gibt?
Wenn Nein könnten es noch Workbook Namen zu anderen Dateien sein. Die können wir auch aufspüren. Das ist aber ein anderer Code.
mfg Gast 123
Code:
Option Explicit 'Verknüpfungen Hajo
Sub Verknuepfte_Zellen()
'**************************************************
'* H. Ziplies *
'* 24.08.08 *
'* erstellt von HajoZiplies@web.de *
'* http://Hajo-Excel.de/ *
'**************************************************
On Error GoTo Fehler1 ' Fehlerbehandlung ausschalten
Dim RaZelle As Range ' Variable für aktuelle Zelle
Dim ByMldg As Byte ' Variable Meldung
Dim WsSh As Worksheet ' Variable Tabelle
Dim ObZelle As Object ' Variable für Namen
For Each WsSh In Worksheets ' Schleife über alle Tabellen der Datei
' Prüfen ob Tabelle schon vorhanden
If InStr(WsSh.Name, "Verknüpfungen") > 0 Then
ByMldg = MsgBox("Eine Tabelle mit dem Namen " _
& "Verknüfungen ist schon vorhanden, sollen die " _
& "Daten gelöscht werden", vbYesNo + vbQuestion, _
"Löschabfrage ?", "", 0)
If ByMldg = 6 Then ' Ja wurde gedrückt
' Zellen komplett löschen,
' da schon bestimmte Formate eingestellt
WsSh.Cells.Delete
' Kennzeichnen dass Tabelle schon vorhanden
ByMldg = 45
' Schleife verlasse, da Tabelle gefunden
Exit For
Else
Exit Sub
End If
End If
Next WsSh
Application.ScreenUpdating = False ' Bildschirmaktualisierung ausschalten
Application.EnableEvents = False ' Reaktion Eingabe abschalten
If ByMldg <> 45 Then ' Tabelle anlegen falls noch nicht vorhanden
' Anlegen hinter der letzten Tabelle ubnd Namen geben
Sheets.add(After:=Sheets(Sheets.Count)).Name = "Verknüpfungen"
With ActiveWindow
.SplitRow = 2
.FreezePanes = True
End With
End If
With Worksheets("Verknüpfungen")
' Überschriftszeilen
' Formel mit Ergebnis Fehler
.Cells(1, 1) = "Formel mit Ergebnis Fehler"
.Cells(2, 1) = "Zelle"
.Cells(2, 2) = "Tabelle"
.Cells(2, 3) = "Formel"
' Formel zu anderen Arbeitsmappe
.Cells(1, 5) = "Formel zu anderen Arbeitsmappe"
.Cells(2, 5) = "Zelle"
.Cells(2, 6) = "Tabelle"
.Cells(2, 7) = "Formel"
' Formel zu anderen Tabellen in dieser Arbeitsmappe
.Cells(1, 9) = "andere Tabelle"
.Cells(2, 9) = "Zelle"
.Cells(2, 10) = "Tabelle"
.Cells(2, 11) = "Formel"
' restliche Formel
.Cells(1, 13) = "Rest"
.Cells(2, 13) = "Zelle"
.Cells(2, 14) = "Tabelle"
.Cells(2, 15) = "Formel"
' definierte Namen in dieser Arbeitsmappe
.Cells(1, 17) = "definierte Namen"
.Cells(2, 17) = "Name"
.Cells(2, 18) = "Zelle"
.Cells(2, 19) = "Tabelle"
Rows("1:2").Font.Bold = True
For Each WsSh In Worksheets ' Schleife über alle Tabellen
If WsSh.Name <> "Verknüpfungen" Then
' Schutz aufheben falls vorhanden
' WsSh.Unprotect "Passwort"
On Error Resume Next
Set RaZelle = WsSh.UsedRange.SpecialCells(xlCellTypeFormulas)
Set RaZelle = Nothing
If Err.Number = 0 Then
On Error GoTo 0
' Schleife über den benuzten Bereich mit Formel
For Each RaZelle In WsSh.UsedRange.SpecialCells(xlCellTypeFormulas)
' Formeln mit Fehler
If IsError(RaZelle.Value) Then
.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1) _
= RaZelle.Address(0, 0)
.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 2) _
= CStr(WsSh.Name)
.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 3) _
= "'" & RaZelle.FormulaLocal
' Formel zu anderer Arbeitsmappe
ElseIf InStr(RaZelle.Formula, ":\") <> 0 Then
.Cells(.Cells(.Rows.Count, 5).End(xlUp).Row + 1, 5) _
= RaZelle.Address(0, 0)
.Cells(.Cells(.Rows.Count, 5).End(xlUp).Row, 6) _
= CStr(WsSh.Name)
.Cells(.Cells(.Rows.Count, 5).End(xlUp).Row, 7) _
= "'" & RaZelle.FormulaLocal
' Formel zu andere Tabelle
ElseIf InStr(RaZelle.Formula, "!") > 1 Then
.Cells(.Cells(.Rows.Count, 9).End(xlUp).Row + 1, 9) _
= RaZelle.Address(0, 0)
.Cells(.Cells(.Rows.Count, 9).End(xlUp).Row, 10) _
= CStr(WsSh.Name)
.Cells(.Cells(.Rows.Count, 9).End(xlUp).Row, 11) _
= "'" & RaZelle.FormulaLocal
Else ' restliche Formeln
.Cells(.Cells(.Rows.Count, 13).End(xlUp).Row + 1, 13) _
= RaZelle.Address(0, 0)
.Cells(.Cells(.Rows.Count, 13).End(xlUp).Row, 14) _
= CStr(WsSh.Name)
.Cells(.Cells(.Rows.Count, 13).End(xlUp).Row, 15) _
= "'" & RaZelle.FormulaLocal
End If
Next RaZelle
End If
On Error GoTo 0 ' Fehlerbehandlung einschalten
End If
' WsSh.Protect "Passwort" ' Schutz wieder setzen
Next WsSh
' Programmteil Namen auslesen
' Schleife über alle Namen der Datei
For Each ObZelle In ActiveWorkbook.Names
.Cells(.Cells(.Rows.Count, 17).End(xlUp).Row + 1, 17) _
= ObZelle.Name
With .Cells(.Cells(.Rows.Count, 17).End(xlUp).Row, 18)
If InStr(ObZelle, "REF") <> 0 Then
.Value = Mid(ObZelle, InStr(ObZelle, "!") + 1)
.Font.Bold = True
.Font.ColorIndex = 3
ElseIf InStr(ObZelle, "\") <> 0 Then
.Value = Mid(ObZelle, InStr(ObZelle, "!") + 1)
.Font.Bold = True
.Font.ColorIndex = 4
Else
.Value = Mid(ObZelle, InStr(ObZelle, "!") + 1)
End If
End With
If InStr(ObZelle.RefersTo, "!") > 0 Then
.Cells(.Cells(.Rows.Count, 17).End(xlUp).Row, 19) _
= Application.WorksheetFunction.Substitute(Mid(ObZelle, _
2, InStr(ObZelle, "!") - 2), "'", "")
Else
.Cells(.Cells(.Rows.Count, 17).End(xlUp).Row, 19) _
= ObZelle.RefersTo
End If
Next
.Range("B:C,F:G,J:K,N:O, R:S").EntireColumn.AutoFit
' Überschriftszeilen
' Formel mit Ergebnis Fehler
.Cells(1, "A") = "Zellen mit Ergebnis Error"
' Formel zu anderen Arbeitsmappe
.Cells(1, "E") = "Formeln zu anderen Arbeitsmappen"
' Formel zu anderen Tabellen in dieser Arbeitsmappe
.Cells(1, "I") = "Formeln zu anderen Tabellen"
' restliche Formel
.Cells(1, "M") = "restliche Formeln"
' definierte Namen in dieser Arbeitsmappe
.Cells(1, "O") = "Namen in dieser Arbeitsmappe"
End With
Fehler1:
On Error GoTo 0 ' Fehlerbehandlung eimschalten
If Err <> 0 Then MsgBox "Es ist ein Fehler aufgetreten!"
Application.ScreenUpdating = True ' Bildschirmaktualisierung einschalten
Application.EnableEvents = True ' Reaktion Eingabe einschalten
End Sub
da sollte man schon aufspüren worum es siich handelt. Also, mit Alt+F11 den VBA Editor öffnen und ein normales Modulblatt einfügen (rechte Maustaste). Dann den Kopie von Hajo hinein kopieren, den Cursor in den Text HINTER "Sub Verknüpfung" setzen, und das Makro mit der Taste F5 starten. Es wird angezeigt ob es Formeln gibt, wenn ja in welchen Zellen, und ob sie mit einer externen Datei verknüpft sind. Das sollten wir zuerst testen.
Hier noch ein Code, nur um zu testen ob es Workbook Namen gibt. Wenn du selbst KEINE verwendest kannst du sie ggf. mit dem 2. Makro löschen.
mfg Gast 123
Code:
Sub Test()
MsgBox ActiveWorkbook.Names.Count
End Sub
Sub WBNamen_löschen()
For j = 1 To ActiveWorkbook.Names.Count
ActiveWorkbook.Names(1).Delete
Next j
End Sub
28.11.2019, 07:58 (Dieser Beitrag wurde zuletzt bearbeitet: 28.11.2019, 07:58 von Kapi.)
Hi Vielen Dank für die Beschreibung.
Nun habe ich eine elend lange Liste.
1) Zellen mit Ergebnis Error -> sind viele Einträge drin vorhanden -> (sind jedoch in den ausgeblendeten SApalten/ Zellen, da ich diese für meine Bearbeitung nicht brauche (waren vorher auch schon da)
2) Formeln zu anderen Arbeitsmappen -> kein Eintrag
3) Formeln zu anderen Tabellen -> viele Einträge vorhanden
4) restliche Formeln -> Viele Einträge vorhanden
5) definierte Namen -> Keine Einträge vorhanden
28.11.2019, 10:49 (Dieser Beitrag wurde zuletzt bearbeitet: 28.11.2019, 10:49 von Kapi.)
(28.11.2019, 07:58)Kapi schrieb: Hi Vielen Dank für die Beschreibung.
Nun habe ich eine elend lange Liste.
1) Zellen mit Ergebnis Error -> sind viele Einträge drin vorhanden -> (sind jedoch in den ausgeblendeten SApalten/ Zellen, da ich diese für meine Bearbeitung nicht brauche (waren vorher auch schon da)
2) Formeln zu anderen Arbeitsmappen -> kein Eintrag
3) Formeln zu anderen Tabellen -> viele Einträge vorhanden
4) restliche Formeln -> Viele Einträge vorhanden
5) definierte Namen -> Keine Einträge vorhanden
Und nun?
Kleine Ergänzung:
Ich habe das ein paar mal durchlaufen lassen und habe die Arbeitsmappe in der Hinsicht bereinigt dass ich bei "Zellen mit Ergebnis Error" keine Einträge mehr habe.
Jedoch habe ich jetzt einträge unter "definierte Namen" ... Was ist das ? und da steht in 7 Zeilen unter Zelle #Bezug! und unter Tabelle steht #Ref
Ich weiß jedoch nicht woher die Tabelle kommt, habe so eine Tabelle nicht in meinem Arbeitsblatt
Dieses hier kommt mir auch verdächtig vor:
definierte Namen
Name Zelle Tabelle
E 519'!ExterneDaten_1 $A$1:$A$2955 E 519
E XXX'!ExterneDaten_1 $A$1:$B$6 E XXX
Weil hier steht ExterneDaten_1 ... oder liegt das daran das ich Power Query verwendet habe?
Anbei noch eine Word Datei mit der Auflistung der "definierten Namen"
28.11.2019, 19:36 (Dieser Beitrag wurde zuletzt bearbeitet: 28.11.2019, 19:44 von Gast 123.)
Hallo
also, gehen wir an die Auswertung deiner Fleissarbeit. In den Formeln scheint KEIN Fehler zu sein, da es keine Verbindung zu externen Tabellen gibt.
Die Formeln in der eigenen Datei spielen dabei keine Rolle. Nur die fehlerhaften sollte man löschen!
Bei den Wb Namen empfehle ich mit dem Makro zuerst mal die #REF Fehler zu löschen. Die haben ohnehin keinen Bezug mehr. Unklar sind mir die verbleibenden zwei WbNamen zu "Externe Daten" Im Zweifelsfall mit dem 2. Makro löschen. (Die For Next Schleife laeuft dabei rückwaerts! Muss so sein)
Ich bin gespannt ob dann der Fehler weg ist??? Vorhersagen kann ich es nicht ....
mfg Gast 123
Code:
Sub WBNamen_RefFehler_löschen()
Dim j As Integer, Zahl As Integer
Zahl = ActiveWorkbook.Names.Count
'alle #REF Namen löschen!
On Error Resume Next
For j = Zahl To 1 Step -1
If InStr(ActiveWorkbook.Names(j).RefersTo, "#REF") Then
ActiveWorkbook.Names(j).Delete
End If
Next j
End Sub
Sub WBNamen_einzeln_löschen()
On Error Resume Next
ActiveWorkbook.Names("E 519'!ExterneDaten_1").Delete
ActiveWorkbook.Names("E XXX'!ExterneDaten_1").Delete
End Sub
Nachtrag sollte der Fehler immer noch vorhanden sein bleibt die Frage ob es Objekte oder Button mit externen Makros gibt??
Als letzte Lösung faellt mir ein die Datei zu kopieren. in der Kopie Datei Blatt für Blatt löschen, speichern, Excel schliessen! Neu öffnen und schauen ob der Fehler weg ist. Dann weiss man zumindest in welcher Tabelle der Fehler steckt, wo man gezielt suchen muss.
