Registriert seit: 29.04.2019
Version(en): 2017
Hallo!
Ich habe folgendes Problem: Eine Excel-Datei ist mit vielen anderen Excel-Datein verknüpft. Es handelt sich um eine Personaleinteilungs-datei. Hier werden von Mitarbeitern mögliche Einteilungen für die Erstellung eines Dienstplans verknüpft. Diese Datei wird jeden Monat neu erstellt - so ändern sich die Monatstage und die Einteilungswünsche und Möglichkeiten der Mitarbeiter. Bei der Umstellung auf ein neues Monat werden alle Daten für das neue Monat im alten Monat überschrieben, weil verknüpft. Ich habe schon in der Excel-Datei unter "Datei/Verknüpfungen bearbeiten" die Verknüpfungen gelöscht. Aber irgendwie funktioniert das nicht. Gibt es eine Möglichkeit die Verknüpfungen einfach und sicher zu deaktivieren, damit die Datei mit den Daten des Vormonats nicht durch die Daten des aktuellen Monats ersetzt werden?
Vielen Dank!
Registriert seit: 11.04.2014
Version(en): 2021
Hallo,
die komplette Datei markieren, kopieren und dann an gleicher Stelle wieder einfügen, aber nicht alles, sonder nur die Werte.
Dann sind alle Formeln, Verknüpfungen und Bezüge weg.
Gruß Günter
aus der Helden-, Messe-, Musik-, Buch-, Universitäts- und Autostadt Leipzig
Registriert seit: 12.03.2016
Version(en): Excel 2003
Halla
mit diesem Programm von Hajo kann man alle Verknüpfungen in einer Datei gezielt auflisten. Man sieht jede einzelne Zelle!
mfg Gast 123
Code: Option Explicit 'Verknüpfung 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
'GoTo weiter:
For Each WsSh In Worksheets ' Schleife über alle Tabellen der Datei
' Prüfen ob Tabelle schon vorhanden
If InStr(WsSh.Name, "Verknüpfung") > 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
Weiter:
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üpfung"
With ActiveWindow
.SplitRow = 2
.FreezePanes = True
End With
End If
With Worksheets("Verknüpfung")
' Ü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üpfung" 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
|