VBA: Zellen per Makro reparieren

[Kuwer]

Hallo,

leere Zellen werden mit meinem Vorschlag auch ausgefüllt.

Gruß, Uwe

[Sabotaz]

Hallo,

jetzt ohne Fehlermeldung (hoffentlich):

Code:

...

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

Ansonsten folgende Zeile löschen oder auskommentieren:

Code:

...

Gruß, Uwe

Oha, was passiert hier? 😂 Sorry, Kuwer, ist sehr lieb, aber ich glaube, das schießt über das Ziel hinaus. Die Fehler (leere Zellen) entsteht ja auch, wenn man die Tabelle normal nutzt und mal was löscht oder so, darum bringt eine Kombination da nichts. Ich hab jetzt versucht, den Inhalt des ersten Codes von dir mit dem zu kombinieren, der Fehler bleibt aber der gleiche. Ich erhalte Laufzeitfehler 5 in der Zeile  " lngPoE = InStr(lngPoA, strF, "]") "

Meine Güte, bin ich blöd. Er bringt mir diesen Fehler, wenn es keine Zellen mehr zu reparieren gibt... Ich such mich dusselig, weil ich denke, dass hier irgendwas nicht stimmt...

---

Jetzetle! Hab hier was zusammengewürfelt, ihr werdet sicher lachen, aber egal, es funktioniert jetzt 😂 Ich hab noch Meldungen angehängt bei Erfolg und Misserfolg, weil mich das so dermaßen verwirrt hat (dachte, der Code hat aufeinmal einen Fehler?!) und dann noch das Tabellenblatt gewechselt. War mir nicht sicher, wie der Code ausgeführt wird, wenn kein Tabellenblatt definiert ist und ich von einem anderen Blatt ausführe... garnicht^^ Aber so geht es jetzt zumindest:

Die Erfolgsmeldung habe ich doppelt gemoppelt, weil ich mir nicht sicher war, wann sie funktioniert. Weil hier auch bei einem Erfolg eine Fehlernummer ausgegeben wird... Keine Ahnung, wie das sein müsste...

Code:

Sub Kopierfehler_beheben_Modul4()
    Dim rngB As Range
    Dim strF As String
    Dim lngPoA As Long, lngPoE As Long

    On Error GoTo ErrorHandler

    Set rngB = Worksheets("Kalender").Range("G12:V389")
    strF = rngB.SpecialCells(xlCellTypeFormulas).Cells(1).Formula

    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

    rngB.SpecialCells(xlCellTypeFormulas).Cells(1).Copy
    rngB.SpecialCells(xlCellTypeBlanks).PasteSpecial xlPasteFormulas
    Application.CutCopyMode = False

    MsgBox "Abgeschlossen." & vbNewLine & "Alle Kopierfehler wurden erfolgreich korrigiert.", vbInformation, "Erfolg"

ExitProcedure:
    On Error Resume Next
    Exit Sub

ErrorHandler:
    Select Case Err.Number
        Case 5
            MsgBox "Es wurden keine weiteren Kopierfehler erkannt.", vbInformation, "Hinweis"
        Case 1004
            MsgBox "Abgeschlossen! Alle Kopierfehler wurden erfolgreich korrigiert.", vbInformation, "Erfolg"
    End Select
    Resume ExitProcedure
End Sub

Aber: Ich könnte ja das automatische Kopieren trotzdem nutzen! Es wäre ziemlich genial, wenn man einen "Export" und einen "Import"-Knopf hätte, der den Bereich automatisch in die Zwischenablage kopiert und man mit dem anderen das dann importiert... Uuuuh... Es artet schonwieder aus, liegt bestimmt an dem Liter Kaffee.

[Sabotaz]

Ich hab jetzt per Makroaufzeichnung kopieren und einfügen erstellt, da noch Messageboxen dazugetan und fertig ist die Laube. Funktioniert klasse! Wenn es andere machen, dann ist das nicht mal so kompliziert 😁😁

Danke an @Kuwer und @Case !

[Sabotaz]

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.


Gruß, Uwe

Hallo Uwe,

Funktioniert an sich echt klasse und zuverlässig, aber ich habe eben noch ein kleines Problem festgestellt:

Wenn die Zelle G12 (also die erste Zelle des Bereichs) keine [ ] enthält, dann wird die Korrektur nicht durchgeführt. Ich habe das beim Test gemerkt, als ich nur einen Bereich mitten in der Tabelle woanders kopiert und bei mir eingefügt habe. Lässt sich da noch was machen? 

Liebe Grüße!

(Wird Kuwer allein durch das Zitat benachrichtigt?!)

[Gast 123]

Hallo

ich habe nicht alles gelesen, nicht alles verstanden, aber um Formelnverschiebungen zu vermeiden hatte ich selbst einen doofen Trick!

Man nehme Suchen/Ersetzen, ersetze das "=" Zeichen durch " '=", das verwandelt die Formeln in einen lesbaren Text!
Dann kopiert man den Bereich und ändert in der Quell- und Zieldatei den Text wieder in eine Formel.  
Das klappt einwandfrei, wenn man es richtig macht.

mfg Gast 123

[Sabotaz]

Man nehme Suchen/Ersetzen, ersetze das "=" Zeichen durch " '=", das verwandelt die Formeln in einen lesbaren Text!

Danke schonmal! Aber das kapier ich nicht. Suchen/Ersetzen, das ist ok. Aber beim Rest komme ich nicht mit...

---

Ach, du meinst VOR dem Kopieren die Formeln der ANDEREN Datei zum Text umwandeln und dann kopieren, einfügen und zurückwandeln. 

Ja, das wäre eine Lösung, aber leider nicht die, die ich brauche. Bei mir ist quasi schon alles zu spät und bereits kopiert und eingefügt und erst dann will ich die Verknüpfung zur anderen Datei löschen.

Ich hab es grade ausprobiert mit Suchen/Ersetzen und ein Makro aufgezeichnet. Ich hatte die Hoffnung, den Suchbegriff durch bspw ein Sternchen offen zu lassen, aber hier funktioniert das so scheinbar nicht. Der Suchbegriff war dann
[*]aber er will einen exakten Treffer haben, also muss ich [alte Datei.xlsx] eingeben. Da aber der Name der alten Datei variiert und mir unbekannt ist, muss ich festlegen, dass alles ab und inklusive [ bis und einschließlich ] durch "" ersetzt werden soll:


Sub SE_Kopierfehler()
'
' SE_Kopierfehler Makro
'

'
    Sheets("Kalender").Select
    Range("G12:V389").Select
    Range("V389").Activate
    Selection.Replace What:="[addad.aca]", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
End Sub

Da sitzt der Hase in der Pfanne begraben. Kann man das irgendwie so umgestalten, dass das passt?

---

Ich glaube, ich raffe langsam den Code und kann Teile von Kuwers Code einbasteln. Aber letztendlich lande ich dann doch wieder beim selben Code und damit beim selben Problem... Ich dreh mich wieder im Kreis 

---

Ich mach das jetzt anders. Pfusch, aber mir egal.

Da ich ohnehin die Abfrage habe, ob irgendwo in dem Bereich ein "[" vorkommt, nutze ich die. Wenn "[" vorhanden, dann gebe ich zu Beginn des Codes den Befehl, in die erste Zelle des Bereichs (G12) die Formel zu manipulieren, dass auch dort ein "[" enthalten ist. Danach lasse ich Suchen und Ersetzen (mit dem Code von Kuwer) durchlaufen und hat.

[Gast 123]

Hallo

kannst du uns die Datei mit den Formeln hochladen, und von Hand vorgeben wie die Formel geändert werden muss.
Per VBA kann man Stringteile mit [] gezielt herausschneiden, oder ggf. durch anderen Text ersetzen. Den Dateinamen müssen wird nicht kennen!
Dazu sollte ich aber die Datei oder die Formeln mal als Text sehen, dann kann ich mir mal Gedanken machen wie man es programmieren kann.

mfg Gast 123

[Kuwer]

Hallo Sabotaz,

teste es mal damit:

Code:

Sub ExterneLinksInInterneLinksUmwandeln()
  Dim aLinks As Variant
  Dim i As Long
  Dim strSelf As String
  
  aLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
  If Not IsEmpty(aLinks) Then
    strSelf = ActiveWorkbook.Name
    For i = 1 To UBound(aLinks)
      ActiveWorkbook.ChangeLink Name:=aLinks(i), _
                             NewName:=strSelf, _
                                Type:=xlExcelLinks
    Next i
  End If
End Sub

Damit werden externe Links auf interne Links geändert (sofern möglich). Die externen Mappen müsen nicht geöffnet werden.

Gruß, Uwe

[Sabotaz]

Damit werden externe Links auf interne Links geändert (sofern möglich). Die externen Mappen müsen nicht geöffnet werden.

Oh man... Das ist ja so klein im Vergleich zu dem anderen! 

Funktioniert super! Vielen Dank! 

[Sabotaz]

Edit: das funktioniert, solange die Datei offline gespeichert wird.   Habe sie jetzt auf OneDrive synchronisiert und mir wird nun in jeder Zelle, in der der Bezug extern ist ein Bezug hinzugefügt mit dem Namen dieser Datei, statt ihn zu löschen. Das heißt, funktionieren würde es, allerdings wird der Inhalt der Klammern und die Klammern selbst nicht gelöscht. Zusätzlich wird der Dateipfad ('mycompany.sharepoint.global(etc)[diese Date.xlsm]Tabelle1'!...) erzeugt, also mit " ' ", wodurch das andere Modul, das nur den Inhalt von [*] und die Klmern selbst löscht, nicht mehr funktionieren würde.

Die Frage ist jetzt: hat das Einfluss auf die Performance, wenn knapp 6000 Zellen jeweils drei Mal einen solchen Bezug enthalten? Wenn nein, wäre das schon mal ok. 

Ansonsten bräuchte ich einen Code, der mir die Zelle G12 einfach abändert und vor irgendeinen Bezug noch [123] einfügt, damit der ursprüngliche Code von Kuwer, bzw Suchen und Ersetzen richtig funktioniert. Das Problem dabei ist aber, dass sich immer ein Fenster öffnet, damit man eine Datei auswählen kann. Das müsste ich auch irgendwie umgehen oder automatisch mit Abbrechen beantworten, aber das kriege ich nicht auf die Reihe (Makro aufzeichnen erkennt das Fenster nicht).

Gibt es dazu noch eine Idee?