Office: Makro feinschliff (Neuland fuer mich)

Hallo Liebe Excelfans,

in den letzten 2 Wochen konnte ich, dank der Hilfe des Forums, ein tolles Tool erstellen. Nun sind 2 Nachbarabteilungen so begeistert dass sie es auch haben moechten. Weitere werden sicher folgen. Deshab will ich meine Excelfile generalisieren :).

Das gelingt mir auch soweit. Dank den wunderbaren Erklaerungen einiger Forumsmitgliedern habe ich mein Makro zu 90% schreiben koennen. Jetzt fehlt ein letzter Befehl.
Wie man in dem Makro sehen kann erstelle ich eine neues Worksheet. Es geht nun darum die makros aus dem Quellsheet (selbe datei) in das neu erstellte sheet zu kopieren.

Mein bisheriger Code

Code:

Sub CreateYourFile()
Dim AA As Variant
Dim BB As Integer
Dim i As Variant
Dim neuTab As Worksheet
Dim wsA As Worksheet
Dim lngRowPool As Long
Dim lngRowMA As Long
Dim lngCounter As Long
Sheets("pool").Activate
'Abfrage nach der Mitarbeiteranzahl
BB = Application.InputBox("Wie viele Tabs sollen erstellt werden?", "Mitarbeiteranzahl")
For i = 1 To BB Step 1

'Abfrage wie die einzelnen Sheets benannt werden sollen

AA = Application.InputBox("Wie is der Name des Mitarbeiters?" & vbCr & vbCr & "Oder wie soll der Task kategorisiert werden?", "Kategorisierung")
 
 If AA = False Then
                 Exit Sub
         Else
            
            'Kopiervorgang
            
                    Set wsA = Worksheets("A")
                     wsA.Activate
                     wsA.Cells.Select
                     Selection.Copy
   
                    Set neuTab = Worksheets.Add
                     neuTab.Name = AA
                     neuTab.Activate
                     neuTab.Cells.Select
                     neuTab.Paste
                     Range("A1") = AA
                     
                     ActiveWindow.View = xlNormalView
            
            
          
              End If
            Next i
            
     End Sub

Makros die Kopiert werden sollen (beide befinden sich im Quelltabellenblatt "A")

Makro 1

Code:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lngRowPool As Long
Dim lngRowMA As Long
Dim lngRowMA2 As Long
Dim lngRowDone As Long
Dim lngCounter As Long
Dim objSheet As Object
    With Me
        lngRowMA = .Cells(.Rows.Count, 2).End(xlUp).Row
        For lngCounter = lngRowMA To 4 Step -1
            If .Cells(lngCounter, 1).Font.Strikethrough = True Then
                lngRowDone = ThisWorkbook.Worksheets("Done").Cells(.Rows.Count, 2).End(xlUp).Row + 1
                ThisWorkbook.Worksheets("Done").Rows(lngRowDone).Insert shift:=xlDown
                .Rows(lngCounter).EntireRow.Copy Destination:=ThisWorkbook.Worksheets("Done").Rows(lngRowDone)
                Me.Rows(lngCounter).EntireRow.Delete shift:=xlUp
            ElseIf Not .Cells(lngCounter, 1) = Me.Name Then
                If .Cells(lngCounter, 1) = "" Then
                    lngRowPool = ThisWorkbook.Worksheets("Pool").Cells(.Rows.Count, 2).End(xlUp).Row + 1
                    ThisWorkbook.Worksheets("Pool").Rows(lngRowPool).Insert shift:=xlDown
                    .Rows(lngCounter).EntireRow.Copy Destination:=ThisWorkbook.Worksheets("Pool").Rows(lngRowPool)
                    Me.Rows(lngCounter).EntireRow.Delete shift:=xlUp
                Else
                    For Each objSheet In ThisWorkbook.Worksheets
                        If objSheet.Name = .Cells(lngCounter, 1) Then
                            With objSheet
                                lngRowMA2 = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
                                .Rows(lngRowMA2).Insert shift:=xlDown
                                Me.Rows(lngCounter).EntireRow.Copy
                                .Rows(lngRowMA2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                                Me.Rows(lngCounter).EntireRow.Delete shift:=xlUp
                                Exit For
                            End With
                        End If
                    Next objSheet
                End If
            End If
        Next lngCounter
    End With
End Sub

Makro 2

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim S As Variant
Dim t As String
    If Target.Column = 5 Or Target.Column = 6 Then frmcalendar.Show
    If Target.Column = 4 Then
        t = MsgBox(Target.Value, vbOKCancel, "Summary")
        If (t = vbOK) Then
            S = Application.InputBox("Gibt es ein Status Update?", "Status Update")
            If S = False Then
                Exit Sub
            Else
                If Not Target.Value = "" Then Target.Value = Target.Value & vbLf
                If S = "" Then
                    Target.Value = Target.Value & Date & " : " & "No Change!"
                Else
                    Target.Value = Target.Value & Date & " : " & S
                End If
            End If
        End If
    End If
    
End Sub
 

Wie gesagt beide Makros sollen kopiert werden. Sollte es zu irgendwelchen effizienzsteigerungen kommen, werden diese gerne angenommen. Aber primaer geht es darum diese beiden Makros in mein neu erstelltes Sheet zu bekommen.
Hat jemand eine Idee?

Liebe Gruesse Nico

 

Hallo Nico,

soweit mir bekannt unterbinden die Sicherheitseinstellungen das Kopieren bzw. generell das Verändern von Code mithilfe von Makros.
Natürlich könnte man diese Einstellungen ändern/aufheben, aber das ist nicht empfehlenswert weil gefährlich.


Abgesehen davon gehts auch viel einfacher, wobei wir wieder bei "think simple" wären.
;O)

Wenn Du ein Blatt kopieren willst, dann mach das doch auch, anstatt alle Zellen zu kopieren und in ein neues Blatt einzufügen.
Mache einen Rechtsklick auf den Reiter des Blattes, dann kannst Du eine 1:1 Kopie erstellen.
Mit dieser Methode werden dann nicht nur die Zellen, sodern auch das Code-Modul kopiert.


Anstatt:

Code:

'Kopiervorgang
            
                    Set wsA = Worksheets("A")
                     wsA.Activate
                     wsA.Cells.Select
                     Selection.Copy
   
                    Set neuTab = Worksheets.Add
                     neuTab.Name = AA
                     neuTab.Activate
                     neuTab.Cells.Select
                     neuTab.Paste
                     Range("A1") = AA
                     
                     ActiveWindow.View = xlNormalView

wäre das dann entweder:

Code:

    'Kopiervorgang
        Set wsA = Worksheets("A")
        wsA.Copy Before:=Sheets(1)
        Worksheets(1).Name = AA

Dann hast Du das neue Blatt immer als erstes Blatt in der Mappe, oder:

Code:

    'Kopiervorgang
        Set wsA = Worksheets("A")
        wsA.Copy after:=Sheets(ThisWorkbook.Worksheets.Count)
        Worksheets(ThisWorkbook.Worksheets.Count).Name = AA

Dann hast Du das neue Blatt immer als letztes in der Mappe.


Selbstverständlich kann es auch an jede beliebiege Stelle eingefügt werden, dann wird die Positionierung aber etwas schwieriger.


Eine Sache am Rande:
wo immer möglich verzichte auf "select" und "activate".
Das produziert der Makrorecorder weil er aufzeichnet was Du tust.
Für Makros sind diese beiden Befehle in den allermeisten Fällen aber unnötig und ausserdem sind sie auch starke Bremsen.



Ich hoffe geholfen zu haben.

 

Hi Achim,

wie immer eine Grosse Hilfe. Das mit dem Think simple hat erst jetzt richtig klick gemacht. Ich habe meine vorherige Kopierstrategie nur daran ausgerichtet, wie ich es auch programmieren kann. Das sollte man ja nicht tun. Sondern sich von Anfang an eine Strategie ueberlegen.

Einfach ein Schritt nach dem anderen :). Aber Langsam wirds. Letztes mal hattest du unglaublich viele Muehen darauf verwendet mir die Schleifen beizubringen. Nun kann ichs kaum glauben aber ich hab es zum ersten mal selbst benutzt. Auch wenn es nix grosses ist.

Herzlichen Dank

Nico

 

Hallo Nico,

das ist in meinen Augen eine Notlösung, die ich persönlich nur benutze wenn ich ansonsten garnicht weiter komme.

Generell überlege ich erstmal was ich erreichen möchte:
=> ein Blatt soll kopiert werden

und erst danach überlege ich mir wie ich es umsetzen kann.
Fehlt mir bei einer Umsetzung Programmierwissen, suche ich im Netz. Werde ich nicht fündig und fällt mir auch keine Alternative ein, frage ich im Forum.
Erst wenn alles nix bringt, weiche ich auf eine Notlösung aus, die sich an dem orientiert was ich realisieren kann.

 

Hallo,

Achim danke fuer den Hinweis. So habe ich mich jetzt herangetastet. Jedoch liefert mir das Internet u. meine Skills keine Loesung mehr.

Mittlerweile sieht mein Makro so aus:

Code:

Sub CreateYourFile()
Dim AA As Variant
Dim BB As Integer
Dim i As Variant
Dim neuTab As Worksheet
Dim wsA As Worksheet
Dim lngRowPool As Long
Dim lngColumn As Long
Dim lngCounter As Long
Dim w1 As Worksheet

'Abfrage nach der Mitarbeiteranzahl
BB = Application.InputBox("Wie viele Tabs sollen erstellt werden?", "Mitarbeiteranzahl")
For i = 1 To BB Step 1

'Abfrage wie die einzelnen Sheets benannt werden sollen
AA = Application.InputBox("Wie is der Name des Mitarbeiters?" & vbCr & vbCr & "Oder wie soll der Task kategorisiert werden?", "Kategorisierung")
 
 If AA = False Then
                 Exit Sub
         Else
            
'Kopiervorgang
        Set wsA = Worksheets("A")
        wsA.Copy Before:=Sheets(1)
        Worksheets(1).Name = AA
                     Range("A1") = AA
       ActiveWindow.View = xlNormalView
                     
 [B][U] [COLOR=#ff0000]'Erstellen der Teamliste
[/COLOR][/U][/B][COLOR=#800080]   Sheets("Pool").Select
    Set w1 = Worksheets("Pool")
    With w1
    lngColumn = AA
        lngColumn = .Cells(3, .Columns.Count).End(xlToRight).Column + 1
       .Cells(3, lngColumn).Value = AA    End With
    End with[/COLOR]
          
              End If
            Next i
            
     End Sub

Der farblich markierte bereich soll spaeter folgendes ausfeuhren:
Sobald der MA Name abgefragt wurde, soll sofort das template mit dem namen erstellt werden (bis hier her gehts) UND eine Teamliste erstellen die in Zelle C3(3,3) beginnt. Fortlaufend soll dann mit jedem Namen der ueber die Inputbox abgefragt wird, die MA - Liste erstellt werden und zwar immer in zeile 3. Also Name 1 ist in C3, Name 2 ist in C4, Name 3 in C5, etc....
Dass soll so sein weil sich meine Spalte A ueber "Data validation" auf die Zeile 3 Bezieht. Durch meine Jetzige Anfrage erstelle ich somit gleich automatisch mein MA - Dropdown um die Aufgaben zuzuweisen.

also nochmal: Der Code wie er ist funktioniert bis auf den farbigen Teil. Der Farbige Teil soll lediglich die Namen aus der Inputbox in Zeile 3 Auflisten (vertikal). Und zwar beginnend in Zelle C3(3,3).
Der originalcode war ursprunglich auf eine Reihe ausgelegt. Ich habe die Reihenbefehle mit "column" ersetzt und die position in der Klammer geaendert. Aber das funktionierte nicht. Gibt es eine Loesung dafuer?

LG Nico

 

Hallo Nico,

in Deinem Code ist ein "End With" zuviel, nach anderen Fehlern habe ich jetzt auf die Schnelle nicht gesucht.

Das wollte ich Dir schon seit einiger Zeit schreiben:
Gewöhne Dir besser an Deinen Code durch tab-weises einrücken optisch zu strukturieren, ansonsten wirst weder Du, noch jemand anderes einen Überblick im Code behalten.
Als Beispiel habe ich mal Dein Makro ein wenig "sortiert":

Code:

Option Explicit

Sub CreateYourFile()

Dim AA As Variant
Dim BB As Integer
Dim i As Variant
Dim neuTab As Worksheet
Dim wsA As Worksheet
Dim lngRowPool As Long
Dim lngColumn As Long
Dim lngCounter As Long
Dim w1 As Worksheet

'Abfrage nach der Mitarbeiteranzahl
BB = Application.InputBox("Wie viele Tabs sollen erstellt werden?", "Mitarbeiteranzahl")

    For i = 1 To BB Step 1
    
    'Abfrage wie die einzelnen Sheets benannt werden sollen
        AA = Application.InputBox("Wie is der Name des Mitarbeiters?" & vbCr & vbCr & "Oder wie soll der Task kategorisiert werden?", "Kategorisierung")
        
        If AA = False Then
            Exit Sub
        Else
        'Kopiervorgang
            Set wsA = Worksheets("A")
            wsA.Copy Before:=Sheets(1)
            Worksheets(1).Name = AA
            Range("A1") = AA
            ActiveWindow.View = xlNormalView
            
        'Erstellen der Teamliste
            Sheets("Pool").Select
            Set w1 = Worksheets("Pool")
            With w1
                lngColumn = AA
                lngColumn = .Cells(3, .Columns.Count).End(xlToRight).Column + 1
                .Cells(3, lngColumn).Value = AA
            End With
        End If
    Next i
      
End Sub

Kopiere den Code 1:1 in den Makroeditor und vergleiche ihn mit Deinem.
Den Unterschied und die Lesbarkeit wirst Du sehen.



Ich hoffe geholfen zu haben.

 

Hi Achim,

danke fuer den Ueberswichtlichkeitshinweis. Ich habe das problem geloest dadurch dass ich

"lngColumn = .Cells(3, .Columns.Count).End(xlToRight).Column + 1"

durch

"lngColumn = .Cells(3, .Columns.Count).End(xlToLeft).Column + 1"


ersetzst habe (einfach rumprobiert)

eine Frage bleibt noch. Kann man in diesem Code evtl. den Ablauf so gestalten dass immer nur die 5 aktuellsten Eintraege angezeigt werden? Sollte es 7 Eintraege geben werden nur die neuesten 5 angezeigt. Das reduziert den Leseaufwand.

Code:

' Makro fuer Doppelklick
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim S As Variant
Dim t As String
    If Target.Column = 5 Or Target.Column = 6 Then frmcalendar.Show
    If Target.Column = 4 Then
    'MsgBox
      '  t = MsgBox(Target.Value, vbOKCancel, "Summary")
       ' If (t = vbOK) Then
            S = Application.InputBox("Gibt es ein Status Update?", "Status Update")
            If S = False Then
                Exit Sub
[B]            Else
                If Not Target.Value = "" Then Target.Value = Target.Value & vbLf
                If S = "" Then
                    Target.Value = Target.Value & Format(Date$, "dd.mmm.yyyy") & " : " & "No Change!"
                Else
                    Target.Value = Target.Value & Format(Date$, "dd.mmm.yyyy") & " : " & S
[/B]                End If
            End If
        End If
    End If
    
End Sub

Irgendwo hier waere eine Begrenzung auf 5 Zeilen Gut. Aber da habe ich nichteinmal ahnung wie man das logisch abfragen kann. Geschweige denn wo?
Ueber Tipps waere ich sehr erfreut.
LG

Nico

 

Hallo Nico,

so sollte immer die erste Zeile inklusive Umbruch abgeschnitten werden, sobald 5 Zeilen vorhanden sind und eine neue hinzukommen soll:
(funktioniert aber nur wenn noch nicht mehr als 5 Zeilen vorhanden sind, wenn das nicht okay ist muss ich anpassen)

Code:

' Makro fuer Doppelklick
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
[COLOR=#ff0000]Dim loLänge As Long
Dim loAnzahl As Long[/COLOR]
Dim S As Variant
Dim T As String
'    If Target.Column = 5 Or Target.Column = 6 Then frmcalendar.Show
    If Target.Column = 4 Then
    'MsgBox
      '  t = MsgBox(Target.Value, vbOKCancel, "Summary")
       ' If (t = vbOK) Then
            S = Application.InputBox("Gibt es ein Status Update?", "Status Update")
            If S = False Then
                Exit Sub
            Else
[COLOR=#ff0000]                loAnzahl = Len(Target) - Len(Application.Substitute(Target, Chr(10), ""))
                If loAnzahl >= 4 Then
                    loAnzahl = 0[/COLOR]
[COLOR=#ff0000]                    For loLänge = Len(Target) To 1 Step -1
                        If Mid(Target, loLänge, 1) = Chr(10) Then
                            loAnzahl = loAnzahl + 1
                            If loAnzahl = 4 Then
                                Target = Right(Target, Len(Target) - loLänge)
                                Exit For
                            End If
                        End If
                    Next loLänge
                End If[/COLOR]
                If Not Target.Value = "" Then Target.Value = Target.Value & vbLf
                If S = "" Then
                    Target.Value = Target.Value & Format(Date$, "dd.mmm.yyyy") & " : " & "No Change!"
                Else
                    Target.Value = Target.Value & Format(Date$, "dd.mmm.yyyy") & " : " & S
                End If
            End If
'        End If
    End If
    
End Sub

Ich hoffe geholfen zu haben.

 

Hi Achim,

Ich sehe gerade du hast den code einmal angepasst. Ich kann nciht beurteilen wie er vorher war. Aber so wie er am Ende ist, habe ich mir das vorgestellt.
Nun damit ist es fuer mich leider noch nicht getan. Ich lese den code gerade verstehe ihn aber durch die mittlerweile betraechtliche Anzahl an If bedingungen noch nicht ganz.

LoAnzahl ist eine Variable ok aber was verbirgt sich hinter ihr? Len(Target)?? Keine Ahnung. Kannst du in Worten beschreiben was genau passiert?
Erst hast du mit "If loAnzahl >= 4 Then" Die maximale Anzahl an Zeilen "Bedingung" Definiert oder? Aber warum dann LoAnzahl = 0?
Danach kommen 2 Sachen die ich auch nicht verstanden hab. Als naechstes kommt quasi die Schleife die abgefragt werden muss damit erkannt wird nach welchem Zeilenumbruch geloescht werden muss. Mhm so halb verstehe ich es aber das Len(Target) gibt mir noch ? Verstaendnissprobleme und ich wuerde es gerne verstehen.

Kannst du dir vielleicht ein letztes mal Zeit nehmen?

Liebe gruesse und ein schoenes Wochenende
Nico

 

Hallo Nico,

Die erste Version war etwas einfacher: Ist die Zeilenanzahl in der Zelle = 5, dann entferne die oberste Zeile damit ein neues Update hineingeschrieben werden kann.
Prinzipiell würde dies eigentlich ausreichen, aber ...
Falls in Deiner Datei inzwischen Zellen mit mehr als 5 Zeilen vorhanden sind, oder falls später (warum auch immer) einmal mehr als 5 Zeilen in einer Zelle sein sollten, hätte der Code nicht mehr gegriffen, die Zeilenanzahl wäre in dieser Zelle niemals reduziert worden, weil sie nie = 5 geworden wäre.
Also musste aus "=5" ein ">=5" werden.
Dann wird es aber wiederum notwendig herauszufinden wie hoch denn nun die Zeilenanzahl ist, um vorgeben zu können wieviele Zeilen gelöscht werden müssen, damit nur 4 übrig bleiben (plus die neue ergibt dann wieder 5).
Und genau das ist die vorgenommene Änderung.



Zum besseren Verständnis drösel ich Dir den Code (nur den in roter Schrift) wieder zeilenweise auf:

Code:

loAnzahl = Len(Target) - Len(Application.Substitute(Target, Chr(10), ""))

- "loAnzahl" ist eine Variable des Typs "long", die hier einen Wert zugewiesen bekommt

- "Len()" ist die Abk. von "length" (Länge). Damit kann man die Länge (Anzahl Zeichen) einer Zeichenkette (String) ausgeben. Wenn Du danach googelst, schau direkt auch mal nach "Mid", "Right" und "Left", die gehören quasi alle zusammen.

- "Target" (Ziel) bezeichnet in diesem Fall die momentan aktive Zelle (die wo Du den Doppelklick gemacht hast). Ich habe "Target" noch nie für etwas anderes benutzt, deshalb bin ich mir gerade unsicher ob es auch andere Objekte repräsentieren kann (Buttons, Labels o.ä.). Die "Default-Eigenschaft" von "Target" ist "Value" (Wert), genauso wie z.Bsp. bei "Cells()". Deshalb kann man das "Value" im Code weglassen. Einige wollen es nicht dauernd lesen, finden es unübersichtlich, andere wiederum halten es für schlechten Stil wenn man es weg lässt. In diesem Fall beziehen wir uns also auf den Wert der "doppel-geklickten-Zelle".

- mit "Application.Substitute" kann man einzelne Zeichen oder ganze Zeichenfolgen durch etwas anderes ersetzen, bzw. durch "" auch ersatzlos entfernen. Siehe hierzu:
http://www.online-excel.de/excel/singsel_vba.php?f=32

- "Chr(10)" gibt das Ascii-Zeichen Nr. 10 zurück, in diesem Fall also "new line" (Zeilenumbruch).
Siehe dazu:
http://www.techonthenet.com/excel/formulas/char.php

Die komplette Code-Zeile ersetzt (virtuell, nicht in der Zelle) also alle Zeilenumbruchzeichen im Zellwert und schaut wie lang der Zellwert (String) danach ist:

Code:

Len(Application.Substitute(Target, Chr(10), ""))

Länge(ersetze(Zellwert,zu ersetzendes Zeichen,einzufügendes Zeichen)

Dann wird diese Länge von der kompletten Länge des Zellwertes substrahiert:

Code:

Len(Target) - Len(Application.Substitute(Target, Chr(10), ""))

Und diese Differenz ergibt dann die Anzahl der Zeilenumbruchszeichen (soweit klar?):

Code:

loAnzahl =

Wir wissen jetzt also wie viele Zeilenumbrüche in dieser Zelle vorhanden sind.
Da der Code insgesamt so aufgebaut ist, dass ein Zeilenumbruch nur entsteht wenn auch eine neue Zeile folgt, gilt also immer: "Zeilenanzahl = Anzahl Zeilenumbrüche + 1".
Wenn Du also nur 5 Zeilen höchstens haben möchtest, dann dürfen höchsten 4 Umbrüche vorhanden sein.
Aber, im späteren Code wird ja noch ein Umbruch und eine Zeile hinzugefügt, also dürfen nur 4 alte Zeilen und 3 alte Umbrüche vorhanden sein, bzw. übrig gelassen werden.
Deshalb stellen wir die Bedingung auf:

Code:

If loAnzahl >= 4 Then

Wird diese Bedingung erfüllt, müssen die Zeilen in der Zelle reduziert werden, ansonsten wird der komplette Teil übersprungen und es geht weiter mit:

Code:

If Not Target.Value = "" ...

Da wir ab hier die Variable "loAnzahl" nicht mehr benötigen, habe ich sie für etwas anderes weiter verwendet, um nicht noch eine Variable deklarieren zu müssen (kann man wohl halten wie ein Dachdecker, denn erst wenn es wirklich viele Variablen werden, und der Code sehr komplex, kommen Unterschiede zum tragen). Da diese Variable aber momentan einen Wert hat setze ich sie erstmal auf Null:

Code:

loAnzahl = 0

Da ich keine Methode kenne um komplette Zeilen aus einem Zellwert zu entfernen, suche ich mittels einer Schleife alle Zeilenumbrüche. Dies mache ich rückwärts, denn es sollen ja die "neuesten" Zeilen erhalten bleiben.
Die gefundenen Zeilenumbrüche werden gezählt (loAnzahl).

Wird nun der 4. Zeilenumbruch von rechts (also von hinten gefunden), befinden sich rechts die 4 neuesten Zeilen, und links alle älteren Zeilen die abgeschnitten werden sollen, egal wie viele es sind. Ich befinde mich also genau an der Position im Text, wo ich "schneiden" will. Und da der Schleifenzähler mit der Gesamtlänge des Textes begonnen hat und auf 1 runter zählt, gibt er mir auch genau diese Position aus (das x-te Zeichen).
Also nehme ich wieder die komplette Länge des Textes, subtrahiere das "x-te Zeichen", und die Differenz ergibt die Anzahl Zeichen die ich von rechts (vom Ende) aus behalten möchte.

Nun das ganze anhand des Codes:

Code:

For loLänge = Len(Target) To 1 Step -1

Schleifenzähler zählt rückwärts runter von der Länge des Textes bis zur 1

Code:

If Mid(Target, loLänge, 1) = Chr(10) Then

Bedingung:
Wenn im String(Zellwert,aktuelle Postion, Länge = 1 Zeichen) = Zeilenumbruch ist, dann ...

Code:

loAnzahl = loAnzahl + 1

Anzahl Umbrüche um 1 hochzählen (deshalb vorher auf 0 setzen, damit der erste auch 1 ergibt)

Code:

If loAnzahl = 4 Then

Bedingung:
wenn der 4. Umbruch gefunden wurde

Code:

Target = Right(Target, Len(Target) - loLänge)

Zellwert = rechts(Zelwert, Länge(Zellwert) - aktuelle Position)
Der Zellwert wird links gekürzt, die Zeichen rechts bleiben erhalten.
Erst dieser Befehl "Target =" verändert wirklich den Zellwert, alles andere zuvor hat nur virtuell damit gerechnet und verglichen.

Code:

Exit For

verlasse die Schleife, der Job ist getan, weiter gehts mit der neu einzufügenden Zeile

Ich hoffe, dass Dir der Code nun klar geworden ist.

 

Hallo Achim,

WOW vielen Dank das du dir die Zeit genommen hast. Die Erklaerung war wirklich sehr gut. Auf einmal ist der code nicht mehr so unverstaendlich wie zuvor. Wie immer habe ich deine Erklaerungen abgespeichert um Sie bei neuen Projekten wieder nurtzen zu koennen. Vielen vielen Dank fuer deine unerbittliche Muehe. Es ist wirklich toll, mit welchem Einsatz du mir hilfst. Da moechte ich selbstverstaendlich zeigen dass auch etwas haengen bleibt.

Vielen Dank noch einmal und noch einen guten Start in die Woche.

Liebe Gruesse

Nico