Texte und Formeln automatisiert auffüllen und berechnen

Forumthread: Texte und Formeln automatisiert auffüllen und berechnen

14.02.2025 13:43:38

Christian

Hallo,

ich versuche mich seit Stunden mit ChatGPT da ein Makro zu erstellen, aber immer wenn ein Problem behoben ist, tritt ein neues auf und ich frage deshalb euch

Ausgangslage steht in Blatt Codes.

ich will entweder die Texte und Daten aus P1:S1 in den Bereich D:G oder P1:R1 in den Bereich D:F einer beliebige Zeile kopieren, in der site: steht.
Alles andere soll dann das Makro machen, damit es so aussieht, wie in den Wunschbeispielen.
Dabei auch beachten, dass im Wunschergebnis die Zellen zentriert und kursiv sind und sich das Datumsformat geändert hat.
das Ganze ist blockweise zu betrachten, jeder Block fängt mit einer Zeile an, in der site: steht.
Wenn ich also die Texte statt in Zeile 2 in Zeile 10 einfüge, soll das Auffüllen und Formel einfügen in den Zeilen 10 bis 19 stattfinden, weil in Zeile 20 der nächste Block anfängt.

Dabei soll folgendes noch gewährleistet sein:

1. es soll unabhängig davon funktionieren, ob ich die Texte und Daten einzeln kopiere oder alle gleichzeitig.
2. Wenn ich Zeilen lösche (egal ob eine oder mehrere) soll außer dem Löschen der Zeilen nichts weiter passieren.

Gruß
Christian

https://www.herber.de/bbs/user/175674.xlsm

Ich hab den letzten Stand von Chatgpt auch mal in die Datei eingefügt, vielleicht ist ja etwas davon brauchbar.

Und bitte ganz wichtig, keine Lösung, die ich von Hand starten muss, das soll vollautomatisch geschehen, sobald ich die Zellen einfüge.

Grund weshalb ich überhaupt so ein Makro suche ist, dass die Texte im Original nicht nur aus Bereichen innerhalb der Datei kopiert werden, sonden teils auch aus dem Browser und Texte die ich aus dem Browser kopiere kann ich nicht gleichzeitig in mehrere Zellen einfügen, sondern bekomme die Meldung dass die einzufügenden DAten nicht die gleiche Größe wie der ausgewählte Bereich hätten. Wegen dem Kopieren einzelner Daten aus dem Internet muss es auch funktionieren, wenn ich nur einzelne Zellen einfüge anstatt den ganzen Bereich auf einmal.
Das das Makro das Berechnen der Formeln auch übernehmen soll liegt daran, dass es bei 320.000 Zeilen jedes mal einen kleinen Moment braucht, bis sie berechnet sind. Durch das Makro kann ich die Berechnung auf die Zeilen beschränken in denen gerade zuvor etwas eingefügt wurde.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Texte und Formeln automatisiert auffüllen und berechnen

14.02.2025 14:14:18

Onur

Ziemlich viele Wünsche für eine kostenlose Hilfe bei kleineren Problemen...
Klingt schon fast nach Auftragsprogrammierung.

so schlimm?

14.02.2025 14:20:37

Christian

Hallo Onur,

danke erstmal für deine Antwort.
Können wir uns darauf einigen, dass ich unter den vielen Chatgpt Vorschlägen den heraussuche, wo nur 1, maximal 2 kleinere Dinge nicht funktioniert haben, wie Alter um ein Jahr falsch berechnet, oder Formatierungen in den falschen Zellen, aber alles andere funktioniert hat und wir passen das dann an?

Gruß
Christian

AW: so schlimm?

14.02.2025 14:25:18

Onur

Vergiss mal deinen Code, egal ob von dir oder CHATGPT, ich analysiere nix, was sowieso nicht funktioniert - neu schreiben geht schneller.
Nenne mir ein (max 2) Problem(e), die gelöst werden sollen.

AW: so schlimm?

14.02.2025 16:23:33

Christian

Hallo Onur,

ich habe jetzt ein Makro, dass zu 99% funktioniert.

Ich hoffe das 1% kann man ändern ohne ein komplett neues Makro schreiben zu müssen.
Und zwar das berechnen des Alters und das Löschen des Texts passiert nur in den Zeilen, in denen das Makro etwas in Spalte G eingefügt hat, nicht in der Zeile in der ich etwas in Spalte G einfüge um das Makro auszulösen. Soll in beiden Fällen passieren

(Der Code funktioniert in meiner Originaldatei, weil Spalte A dort komplett gefüllt ist, daher kann ich anhand Spalte A die letzte Zeile berechnen).

Gruß
Christian

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Codes")

    Dim LastRow As Long: LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    Dim cell As Range, targetRow As Long

    Dim deleting As Boolean

    Dim birthDate As Date, refDate As Date, age As Variant

    Dim sourceValue As Variant

    Dim affectedRows As Object

    Set affectedRows = CreateObject("Scripting.Dictionary")



    ' Prüfen, ob eine Zeile gelöscht wurde

    If deleting Or (Target.Cells.CountLarge > 1 And Application.CutCopyMode = False) Then

        deleting = Not deleting

        Exit Sub

    End If



    ' Berechnungen und Bildschirmaktualisierung deaktivieren (Performance-Boost)

    Application.EnableEvents = False

    Application.Calculation = xlCalculationManual

    Application.ScreenUpdating = False



    ' Verarbeitung aller betroffenen Zellen

    For Each cell In Target.Cells

        affectedRows(cell.Row) = True ' Zeile für spätere Formatierung speichern



        Select Case cell.Column

            ' Spalte E oder G: Datum ins Format TT.MM.JJJJ umwandeln

            Case 5, 7

                If IsDate(cell.Value) Then cell.Value = Format(cell.Value, "DD.MM.YYYY")



            ' Spalte F: IMDB-URL generieren

            Case 6

                cell.Offset(0, 3).Value = IIf(IsEmpty(cell.Value), "", _

                    "https://web.archive.org/web/20220605090056/https://www.imdb.com/name/" & cell.Value & "/")



            ' Spalte G: Alter berechnen + Spalte I leeren (auch für die direkt bearbeitete Zeile)

            Case 7

                birthDate = cell.Value

                refDate = cell.Offset(0, -2).Value ' Spalte E als Referenzdatum

                age = IIf(IsDate(birthDate) And IsDate(refDate), _

                    Year(refDate) - Year(birthDate) - IIf(DateSerial(Year(refDate), Month(birthDate), Day(birthDate)) > refDate, 1, 0), "")



                cell.Offset(0, 1).Value = age  ' Alter berechnen und in Spalte H eintragen

                cell.Offset(0, 2).ClearContents ' Spalte I leeren



        End Select



        ' Automatische Übertragung in nachfolgende Zeilen bis "site:" in Spalte D erreicht wird

        If cell.Column >= 4 And cell.Column = 7 And Not IsEmpty(cell.Value) Then

            sourceValue = cell.Value

            For targetRow = cell.Row + 1 To LastRow

                If Left(ws.Cells(targetRow, 4).Value, 5) = "site:" Then Exit For



                ws.Cells(targetRow, cell.Column).Value = sourceValue

                affectedRows(targetRow) = True ' Zeile für spätere Formatierung speichern



                ' Falls Spalte E oder G betroffen ist, Datumsformat setzen

                If cell.Column = 5 Or cell.Column = 7 Then

                    If IsDate(ws.Cells(targetRow, cell.Column).Value) Then

                        ws.Cells(targetRow, cell.Column).Value = Format(ws.Cells(targetRow, cell.Column).Value, "DD.MM.YYYY")

                    End If

                End If



                ' Falls Spalte G betroffen ist, Alter berechnen & Spalte I leeren

                If cell.Column = 7 Then

                    birthDate = ws.Cells(targetRow, 7).Value

                    refDate = ws.Cells(targetRow, 5).Value

                    age = IIf(IsDate(birthDate) And IsDate(refDate), _

                        Year(refDate) - Year(birthDate) - IIf(DateSerial(Year(refDate), Month(birthDate), Day(birthDate)) > refDate, 1, 0), "")



                    ws.Cells(targetRow, 8).Value = age

                    ws.Cells(targetRow, 9).ClearContents ' Spalte I leeren

                End If



                ' Falls Spalte F betroffen ist, URL in Spalte I aktualisieren

                If cell.Column = 6 Then

                    ws.Cells(targetRow, 9).Value = IIf(IsEmpty(ws.Cells(targetRow, 6).Value), "", _

                        "https://web.archive.org/web/20220605090056/https://www.imdb.com/name/" & ws.Cells(targetRow, 6).Value & "/")

                End If

            Next targetRow

        End If

    Next cell



    ' **Kursiv + Zentriert für alle betroffenen Zeilen**

    Dim rowIndex As Variant

    For Each rowIndex In affectedRows.Keys

        With ws.Range(ws.Cells(rowIndex, 4), ws.Cells(rowIndex, 9))

            .Font.Italic = True

            .HorizontalAlignment = xlCenter

        End With

    Next rowIndex



    ' Berechnungen & Bildschirmaktualisierung wieder aktivieren

    Application.Calculation = xlCalculationAutomatic

    Application.ScreenUpdating = True

    Application.EnableEvents = True

End Sub

hoffe ich hab das Problem lösen können

14.02.2025 23:09:09

Christian

jedenfalls ist mir aufgefallen, beim Einzelausführen, dass selbst wenn es sich um Spalte G handelt, zwar der Case 5, 7 abgearbeitet wird aber nicht der spätere Case 7. Habs dann wie im unteren Teil mit If cell.column gemacht und dann hat es funktioniert.

AW: hoffe ich hab das Problem lösen können

14.02.2025 23:20:52

Onur

Select Case ist fast genauso wie If Then Else
Wenn du das durchlaufen lassen würdest:

    x = 7

    If x = 5 Or x = 7 Then

    MsgBox "5,7"

    Else

        If x = 7 Then MsgBox "7"

    End If

Was passiert dann wohl???

AW: hoffe ich hab das Problem lösen können

14.02.2025 23:25:45

Christian

klar, wenn die erste Bedingung x=7 erfüllt ist wird die zweite nicht mehr geprüft.
Nur wusste ich nicht, dass Select Case auf dem Weg funktioniert. Vorher dachte ich, es prüft jeden Fall einzeln. Wieder was gelernt.
Da hat mich die einzelschrittausführung ja auch mit der Nase draufgestupst und als ich dann gemerkt hab, dass der untere Teil mit if cell.column funktioniert hab ich mir gedacht, machst es genauso.

Und dann hats geklappt.

Danke für die Zeit die du dir genommen hast
Christian

Gerne !

14.02.2025 23:27:53

Onur

Gerne !

14.02.2025 23:35:23

Onur

Du hättest es mit Case anders machen müssen: In Case 7 alles, was schon drin ist plus die Zeile bei Case 5 und dann Case 5 (ohne 7), Case 6 und Case 7 nehmen

das muss ich mir morgen mal in Ruhe anschauen owT

14.02.2025 23:45:20

Christian

aber danke für den Tipp owT

14.02.2025 23:45:52

Christian

AW: so schlimm?

14.02.2025 14:26:59

Onur

Ich meine: eine genaue Beschreibung eines konkreten Problems/einer konkreten Aufgabenstellung....

Texte und Formeln automatisiert auffüllen und berechnen

Forumthread: Texte und Formeln automatisiert auffüllen und berechnen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Texte und Formeln automatisiert auffüllen und berechnen

Forumthread: Texte und Formeln automatisiert auffüllen und berechnen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread