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, 08:58 (Dieser Beitrag wurde zuletzt bearbeitet: 28.11.2019, 08: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, 11:49 (Dieser Beitrag wurde zuletzt bearbeitet: 28.11.2019, 11:49 von Kapi.)
(28.11.2019, 08: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, 20:36 (Dieser Beitrag wurde zuletzt bearbeitet: 28.11.2019, 20: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.
