VBA: Zellen per Makro reparieren

[Sabotaz]

Hallo,

Ich hatte dieses Thema schonmal angefangen, allerdings war damals meine Voraussetzung, dass kein VBA verwendet werden soll. Nun hat sich aber einiges geändert und die Datei enthält mittlerweile andere Makros, wodurch ich sie ohnehin als .xlsm abspeichern musste.

Um folgendes Thema geht es:

Von Dokument1.xlsx zu Dokument2.xlsx kopieren (clever-excel-forum.de)

Nochmal zusammenfassend: Vorhandene Tabelle ist mit Formeln versehen, die manuell überschrieben werden. Kopiert man nun eine fertige Tabelle von G12:V389 in eine neue Datei (wegen einiger Änderungen der Funktionen oä) wird die Formel so geändert, dass sie sich auf die alte Datei mit dessen Speicherpfad etc. bezieht. Damit werden die Funktionen zerstört. Man kann diese auch nicht einfach korrigieren und durch Ziehen erweitern, weil sonst die manuellen Änderungen mit überschrieben werden.

Außerdem: Wird eine Zelle manuell mit Inhalt gefüllt, später wird dieser Inhalt gelöscht, ist die Zelle logischerweise leer. Damit aber weiterhin die Funktion der Formeln bestehen bleibt, müssen die Formeln korrigiert werden.

Jetzt zur Frage: Hat jemand eine Idee zur Umsetzung, wie die Zellen korrigiert werden können? Ich hab mir das irgendwie so vorgestellt:
- Wenn Zelle leer, dann Formel "XYZ" (+Spalte und Zeile)

- Wenn Zelle enthält "[" dann Formel ersetzen durch "XYZ" (+Spalte und Zeile)
ODER
- Suchen '[Dokument1.xlsx]Termine'! ersetzen durch Termine!

ODER einfach generell alle Zellen mit Ergebnis "" oder "0" durch die Formel ersetzen, ohne auf Fehler zu überprüfen ginge auch. Damit würde pauschal alles einmal überschrieben werden, außer Zellen, die bereits manuelle Einträge haben.

Ist das ohne großen Aufwand umsetzbar?


In der Beispieldatei ist ganz oben die erwünschte Formel hinterlegt. Bereich G12 bis V389 enthält diese Formel. Eintragungen, die zu sehen sind (Reparatur, TÜV etc) sind manuelle Eintragungen. Rot markierte Zellen sind leere (fehlerhafte) Zellen, die durch mit der Formel ergänzt werden sollen.

Danke!

[Oberschlumpf]

Hi,

du schreibst im alten Beitrag zwar, dass du die Idee von HKindler ausprobieren wolltest....aber dein Ergebnis/deine Meinung zu dieser Idee hast du dann nicht mehr kundgetan.
Diese Idee könnte man ja auch in ein Makro "packen" (starte den Rekorder, führ die in der Idee genannten Schritte aus, stopp den Rekorder)
Und das neue Makro könnte man dann immer wieder mal per Button starten.

Bin mal auf deine Antwort neugierig.

Ciao
Thorsten

[Sabotaz]

Achsooooo. Mensch, das hab ich ganz vergessen. Einen Augenblick! Ich hatte es glaube ich nicht ausprobiert, weil ich .xlsm vermeiden wollte, dann ist das untergegangen... Danke für die Erinnerung!

Edit: Anderes Problem war glaube ich das Ende für meinen Versuch: Die Dateien heißen immer anders, je nachdem, wie derjenige sie benennt. Dadurch weiß ich nicht, wonach ich suchen soll. Darum habe ich mal an die letzte Variante in meiner Antwort gedacht, ich wusste aber heute nicht mehr, warum...

23.03.2024 --- 11:24Uhr

Ok, ich hab jetzt die Suchen und Ersetzen Methode ausprobiert, die funktioniert super, wenn der zu ersetzende Dateiname immer gleich wäre. Ist er leider nicht, deshalb kann ich kein Makro daraus machen.

Die andere Variante, in der ich die Verbindungen bzw. die Quellen lösche, funktioniert aus Gründen nicht ganz so (?!), die falsche Quelle lässt sich nicht löschen. Stelle ich eine neue Verbindung zur aktuellen Datei her, dann lässt sich die alte Verknüpfung ebenfalls nicht löschen, aber es wird eine neue Verbindung hergestellt. Hier allerdings nicht mit "Termine!$B$12..." sondern mit der internen Adresse "'https://global-my.sharepoint.com/personal/user_company_com/Documents/Dokumente/[Test Zellen reparieren.xlsx]Termine'!$B$12..."

Jetzt habe ich vielleicht einen Ansatz für einen EWorkaround entdeckt, mit dem man leben könnte (hängt von der bedienenden Person ab):

Einfügen könnte man via Strg + V, dann Strg, dann W, damit wären nur die Werte ohne Formeln eingetragen. Das heißt, alle Zellen, die keine manuellen Eintragungen haben, sind dann leer. Wenn sie leer sind, haben sie schon mal einen eindeutigen und unverwechselbaren Zustand.
Dann müsste man "nur noch" ein Makro haben, das leere Zellen mit der entsprechenden Formel füllt.

[00202]

Moin,  

vielleicht kannst du damit was anfangen:  
[attachment=51316]

[Kuwer]

Hallo,

teste mal damit:

Code:

Sub Bereinigen()
  Dim rngB As Range
  Dim strF As String
  Dim lngPoA As Long, lngPoE As Long
  
  Set rngB = Range("G12:V389")
  strF = rngB.SpecialCells(xlCellTypeFormulas).Cells(1).Formula
  lngPoA = InStr(1, strF, "[")
  lngPoE = InStr(lngPoA, strF, "]")
  If lngPoA * lngPoE Then
    strF = Mid(strF, lngPoA, lngPoE - lngPoA + 1)
    rngB.Replace What:=strF, Replacement:="", LookAt:=xlPart, _
                              SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                              ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
  End If
  rngB.SpecialCells(xlCellTypeFormulas).Cells(1).Copy
  rngB.SpecialCells(xlCellTypeBlanks).PasteSpecial xlPasteFormulas
  Application.CutCopyMode = False
End Sub

Gruß, Uwe

[Sabotaz]

Moin,  

vielleicht kannst du damit was anfangen:  

uh, ja! das hat beim ersten Versuch ganz gut geklappt, wenn ich manuell Zellinhalte lösche oder eine 0 einfüge. Wenn ich aber gleich mehrere Zellen einer anderen Tabelle einfüge (mit Strg W), also NUR die Werte übertrage, nicht die Formeln, dann erkennt das Modul die leeren Zellen des frisch eingefügten Bereichs trotzdem nicht, obwohl sie tatsächlich sogar leer sind... Woran kann das liegen? Hat da Excel vielleicht ein Problem?

Edit: Excel hat wirklich ein Problem. Ich habe ja extra die bedingte Formatierung für leere Zellen aktiviert. Die hat bei den eingefügten Zellen, die dann auch leer waren nicht angeschlagen, auch nicht, nachdem ich die Datei neu geöffnet hatte. Erst nachdem ich mal in eine "leere" Zelle reingegangen bin, sodass der Cursor auftaucht und dann mit Enter wieder raus bin, hat sich die Zelle verfärbt. Heißt für mich, Excel fügt Zellen nicht wirklich als leere Zellen ein...

---

Hallo,

teste mal damit:

Code:

...

Gruß, Uwe

Das will er nicht starten, weil er keine Zellen gefunden hat. Was kann dieses Modul? Sehe ich das richtig, dass es nach [ und ] sucht und dessen Inhalte ersetzt? Wenn ja, wodurch wird es ersetzt, das erkenne ich nicht 😓

Edit: Aah, ja, es funktioniert. Es macht aus der externen Verknüpfung eine interne derselben Arbeitsmappe. Das ist sehr gut!
Eine Fehlermeldung, dass er keine Zellen gefunden hätte, kommt trotzdem. Es wird aber erfolgreich geändert!
Dazu müssen aber beide Dateien parallel geöffnet sein. Die alte Quelldatei muss offen bleiben, dann markiert man dort die zu übertragenden Zellen, kopiert sie, fügt sie in die neue Datei ein via Strg + V, dann drückt man Strg für die Einfügeoptionen und dann F für "Formeln". Dann entsteht auch die Verknüpfung, die in den eckigen Klammern steht. Direkt nach dem Einfügen muss das Modul ausgeführt werden. Fügt man die Daten ein und beendet die Datei, dann wird noch der Link der Quelldatei mit angefügt, das sieht dann so aus:

"'h ttps://global-my.sharepoint.com/personal/user_company_com/Documents/Dokumente/[Test Zellen reparieren.xlsx]Termine'!$B$12..."

Das rot markierte bleibt dann auch nach Ausführung bestehen und das Modul funktioniert nicht mehr. Aber diese Regel kann man sich merken, dass man alles in einem Rutsch machen muss und das ist völlig ok!

[Kuwer]

Hallo,

man könnte ja auch das Kopieren der Blätter gleich mit dem Makro erledigen. Durch das gleichzeitige Kopieren der zwei Blätter sollten die Bezüge auch mitwandern, so dass gar keine externe Bezüge entstehen.

Code:

Sub ZweiBlaetterInNeueMappe()
  Dim rngB As Range
  Dim strF As String
  Dim lngPoA As Long, lngPoE As Long
  
  '2 Tabellenblätter in neue Arbeitsmappe kopieren
  Sheets(Array(ActiveSheet.Name, "Termine")).Copy
  
  Set rngB = Range("G12:V389")
  
  On Error Resume Next
  strF = rngB.SpecialCells(xlCellTypeFormulas).Cells(1).Formula
  On Error GoTo 0
  
  'externe Bezüge werden entfernt
  If Len(strF) Then
    lngPoA = InStr(1, strF, "[")
    lngPoE = InStr(lngPoA, strF, "]")
    If lngPoA * lngPoE Then
      strF = Mid(strF, lngPoA, lngPoE - lngPoA + 1)
      rngB.Replace What:=strF, Replacement:="", LookAt:=xlPart, _
                                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                                ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    End If
  End If
  
  'leere Zellen werden mit Formel gefüllt
  If WorksheetFunction.CountBlank(rngB) And Len(strF) Then
    rngB.SpecialCells(xlCellTypeFormulas).Cells(1).Copy
    rngB.SpecialCells(xlCellTypeBlanks).PasteSpecial xlPasteFormulas
    Application.CutCopyMode = False
  End If
  
  'Speichern der neuen Arbeitsmappe
  If Len(ActiveWorkbook.Path) Then
    Application.Dialogs(xlDialogSaveAs).Show
  End If
End Sub

Gruß, Uwe

[Sabotaz]

Ich hab das jetzt als Modul in die originale Datei eingefügt, bekomme jetzt aber einen Laufzeitfehler 5 "Ungültiger Prozeduraufruf oder ungültiges Argument". Beim Debugging wird mir die Zeile " lngPoE = InStr(lngPoA, strF, "]") " markiert. Woran könnte das liegen? Muss ich dem Modul nicht noch sagen, auf welchem Tabellenblatt ich dieses Modul ausführen möchte?

---

Hallo,

man könnte ja auch das Kopieren der Blätter gleich mit dem Makro erledigen. Durch das gleichzeitige Kopieren der zwei Blätter sollten die Bezüge auch mitwandern, so dass gar keine externe Bezüge entstehen.

Code:

...

Gruß, Uwe

---

Funktioniert das, wenn ich nicht weiß, wie die Quelldatei heißt?
Ich bleib lieber bei den getrennten Makros, sonst sehe ich ja gar nicht mehr durch 😁

[Kuwer]

Hallo,

jetzt ohne Fehlermeldung (hoffentlich):

Code:

Sub ZweiBlaetterInNeueMappe()
  Dim rngB As Range
  Dim strF As String
  Dim lngPoA As Long, lngPoE As Long
  
  '2 Tabellenblätter in neue Arbeitsmappe kopieren
  Sheets(Array(ActiveSheet.Name, "Termine")).Copy
  
  Set rngB = Range("G12:V389")
  
  On Error Resume Next
  strF = rngB.SpecialCells(xlCellTypeFormulas).Cells(1).Formula
  On Error GoTo 0
  
  'externe Bezüge werden entfernt
  If Len(strF) Then
    lngPoA = InStr(1, strF, "[")
    lngPoE = InStr(lngPoA + 1, strF, "]")
    If lngPoA * lngPoE Then
      strF = Mid(strF, lngPoA, lngPoE - lngPoA + 1)
      rngB.Replace What:=strF, Replacement:="", LookAt:=xlPart, _
                                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                                ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    End If
  End If
  
  'leere Zellen werden mit Formel gefüllt
  If WorksheetFunction.CountBlank(rngB) And Len(strF) Then
    rngB.SpecialCells(xlCellTypeFormulas).Cells(1).Copy
    rngB.SpecialCells(xlCellTypeBlanks).PasteSpecial xlPasteFormulas
    Application.CutCopyMode = False
  End If
  
  'Speichern der neuen Arbeitsmappe
  If Len(ActiveWorkbook.Path) = 0 Then
    Application.Dialogs(xlDialogSaveAs).Show
  End If
End Sub

Die Quellmappe mit dem zu kopierenden Blatt muss beim Start des Makros aktiv sein.

Ansonsten folgende Zeile löschen oder auskommentieren:

Code:

Sheets(Array(ActiveSheet.Name, "Termine")).Copy

Gruß, Uwe

[Sabotaz]

Ich nehme jetzt das Makro von @Case , das ich dann für das Ausfüllen leerer Zellen verwende und das Makro von @Kuwer um die externen Bezüge zu entfernen. Jetzt müssen die nur noch zum Laufen gebracht werden... :D