Suchen und ersetzen

[RoAdRuNnEr]

Ok.....hab ich jetzt irgendwie nicht so verstanden, aber wenn es Richtig ist, wieso erscheint dann der Makrofehler ?
Ich habe diese zwei Zeilen nun  in :

Windows("Strecken.xls").Activate
Columns("A:B").Select
Selection.Copy
Windows("Aufgaben.xls").Activate
Columns("L:M").Select
ActiveSheet.Paste

ersetzt. Nun funktioniert es damit. (Ich weiß das ist absoluter Beginner Makro geschreibe, aber so lerne ich dazu, selbst wenn der MAkro am Ende so lang ist wie die Reise zum Mond.

Was jetzt noch stört ist, wie gesagt das die Nummerierung nicht per Autofill bis in die letzte Zeile geht, da sich die Standattabelle immer wieder Zeilenmässig vergrössert.
Stand der Dinge ist ja momentan das die Nummerierung bis 11078 geht und dann ist Sense....

[Rudi'S]

Hallo,
 ich habe mir das Makro nicht weiter angesehen.
Aber vielleicht solltest du statt der Zeile
Range("A2").AutoFill Destination:=Range("A2:A11078")

besser
Range("A2").AutoFill Destination:=Range("A2:A" & Lzsort) einsetzen

dann sollte deine Nummerierung auch klappen.

Und wenn du deinen Sortierbefehl in Zeile 2 beginnen würdest, bräuchtest du dann auch nicht die Überschrift wieder nach oben kopieren.

Gruß Rudi

[RoAdRuNnEr]

Ok @Rudi´s.

Das mit der Nummerierung klappt soweit....Danke dafür.  

Lediglich das mit dem sortieren der Spalte D will nicht so Recht klappen, selbst wenn ich vorher die Oberste Zeile fixiere und dann bei D2 alles auszuwählen bis Tabellenende
und diese Spalte von D2-D x sortiere.
Nach der sortierung ist die Oberste Spalte dennoch nicht mehr dort wo sie Eigentlich "nach der fixierung" sein sollte, sondern ist,- wie auch die anderen Spalten, in der letzten Reihe zu finden.

Vorher hatte ich ja nur die ganze Spalte angewählt und diese Alphabetisch sortieren lassen...das dann auch die Überschriftsspalte weg war (trotz fixierung) war mir ja noch klar gewesen.
Aber selbst wenn ich Spalte D2 nur auswähle und mit Doppelklick der Maus unten Rechts alles abwärts anwähle und dann auf sortieren gehe wird dennoch die Reihe 1 mit sortiert von A - x.

Seltsam, oder ?

Das Einzige was helfen könnte ist, daß ich nach der Makroaufzeichnung in VBA anstelle von D1-Ende dieses auf D2-Ende umbenenne.
Aber komisch ist es schon das die Alphabetierung (was für ein Wort) nicht erst ab Spalte 2 beginnt .

Nachtrag :
Klappt auch nicht, dann ist die ganze Alpabetisierung durcheinander.....Grummel....was für eine Geburt.
Hätte ich das Vorher gewußt, daß das alles nicht so Einfach ist, hätte ich es bleiben lassen. Andererseits bin ich auch jetzt mit der Tabelle so weit Voran geschritten, daß ich nicht aufgeben möchte.
Das wäre verschwendete Zeit.
Bin ja Endlos Glücklich überhaupt schon, Dank Euch ! soweit gekommen zu sein, wenn man bedenkt das ich mit Excel seit 2 Wochen mich erst Beschäftige.
Hab schon eine Menge gelernt...

Kurze Frage: Mit welchen Makrobefehl sagt man Excel das man die letzte komplette Zeile ( Z E I L E nicht Z E L L E ) ausgewählt haben möchte, ohne dabei eine Zeilennummer dafür anzugeben ?

[Gast 123]

Hallo

Fehler im Sortier Code:   Setzte den Befehl   .Header = xlNo  bitte  auf xlYes   Es geht darum ob es eine Überschriftzseile gibt, die NICHT sortiert werden soll!!

Heute habe ich den ganzen Tag für mich selbst programmiert, bin richtig müde.  Und eine neue Erkenntniss gewonnen!  Ich schaue mir deinen Code noch mal an sobald ich Zeit dafür habe.  Versuch bitte erst mal die Sortierroutine mit xlYes ans laufen zu bekommen. Bin auf deine Antwort gespannt. 

mfg  gast 123

Code:

    With ActiveWorkbook.Worksheets("SQLiteAdmin").Sort
        .SetRange Range("A1:AE11078")
        .Header = xlNo
        .MatchCase = False    usw.
     End With

---

Nachtrag:  zweiter Sortierfehler, mir schon passiert!! - steht Header auf xlYes und es gibt KEINE Überschrift wird die 1. Zeile NICHT mitsortiert.

[Gast 123]

Hallo

ich habe deinen Code noch mal bereinigt und hange ihn  an.  Würde mich freuen wenn es so einwandfrei klappt.

mfg  Gast 123

Code:

Sub Tabelle()
Dim lzSort As Long    'LastZell Sortierbereich
' Tabelle Makro
' Tabelle TS2021
'
' Tastenkombination: Strg+a
'
    With ActiveWorkbook.Worksheets("SQLiteAdmin")
         lzSort = .Cells(Rows.Count, 1).End(xlUp).Row
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=Range("D1:D" & lzSort), SortOn:= _
          xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:AE" & lzSort)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

    ActiveWindow.SplitRow = 1
    ActiveWindow.FreezePanes = True
   
    Columns("D:D").Delete Shift:=xlToLeft
    Columns("E:F").Delete Shift:=xlToLeft
    Columns("H:H").Delete Shift:=xlToLeft
   
    Windows("Strecken.xls").Activate
    Columns("A:B").Copy
    Windows("Aufgaben.xls").Activate
    Columns("L:M").Select
    ActiveSheet.Paste
   
    Columns("O:AA").Delete Shift:=xlToLeft
   
    With Columns("A:M").Font
        .Color = -16727809
        .TintAndShade = 0
    End With
    With Columns("A:M").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 4.99893185216834E-02
        .PatternTintAndShade = 0
    End With
   
    Columns("N:N").Delete Shift:=xlToLeft
    Columns("N:N").Delete Shift:=xlToLeft
    Columns("C:C").Cut
    Columns("B:B").Insert Shift:=xlToRight
    Columns("G:G").Cut
    Columns("F:F").Insert Shift:=xlToRight
    Columns("J:J").Cut
    Columns("I:I").Insert Shift:=xlToRight
   
    Columns("A:A").ClearContents
    lzSort = .Cells(Rows.Count, 1).End(xlUp).Row
   
    Range("A2").FormulaR1C1 = "=TEXT(ROW(R[-1]C),""00000"")"
    Range("A2").AutoFill Destination:=Range("A2:A" & lzSort)

    Range("A1").Value = "'Nr."
    Range("B1").Value = "'Szenario Name :"
    Range("C1").Value = "'Strecke :"
    Range("D1").Value = "'Beschreibung :"
    Range("F1").Value = "'Aufgabe :"
    Range("G1").Value = "'Startzeit :"
    Range("J1").Value = "'S"
    Range("K1").Value = "'Spielerfahrzeug :"
   
    With Range("A1:F1").Font
        .Name = "Wide Latin"
        .Size = 10
    End With
    With Range("K1").Font
        .Name = "Wide Latin"
        .Size = 10
    End With
    With Range("G1:J1").Font
        .Name = "Wide Latin"
        .Size = 6
    End With
   
    Range("F1").FormulaR1C1 = "'min."
    With Range("F1").Characters(Start:=4, Length:=1).Font
        .Name = "Wide Latin"
        .FontStyle = "Standard"
        .Size = 10
    End With
   
    Columns("A:A").ColumnWidth = 5
    Columns("B:B").ColumnWidth = 50
    Columns("C:C").ColumnWidth = 45
    Columns("D:D").ColumnWidth = 82
   
    Columns("E:E").ColumnWidth = 19
    Columns("F:F").ColumnWidth = 3
    Columns("G:G").ColumnWidth = 5
    Columns("H:H").ColumnWidth = 7
    Columns("I:I").ColumnWidth = 8
    Columns("J:J").ColumnWidth = 1
    Columns("K:K").ColumnWidth = 38
    ActiveWindow.DisplayHeadings = False
   
    Dim rFind As Range, lz2 As Long
    Dim Adr1 As Variant, n As Long
    Adr1 = Right(Range("C2"), 4)
    'Prüfen ob Makro ausgeführt wurde!
    If Not IsNumeric(Adr1) Then
      MsgBox "In Zelle C1 steht bereits Text! - Abbruch!": Exit Sub
    End If

    '** LastZell in Spalte -K- suchen
    lz1 = Cells(Rows.Count, 12).End(xlUp).Row
    lz2 = Cells(Rows.Count, 3).End(xlUp).Row
    'kopiere Spalte C nach Spalte N    (Sicherheits Kopie)
    Range("C2:C" & lz2).Copy
    Range("N2").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.ScreenUpdating = False

    'Suche RoutenNummer in Spalte C
    For Each AC In Range("L2:L" & lz1)
      Application.StatusBar = AC.Row & "  /  " & lz1 & "  /  " & n
      Set rFind = Columns(3).Find(What:=AC, After:=[c1], LookIn:=xlFormulas, LookAt:= _
          xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)

      If Not rFind Is Nothing Then
          Adr1 = rFind.Address
          Do
            n = n + 1  'gedunden Daten zaehlen
            'Text aus Spalte B nach D ausgeben
              rFind.Value = AC.Offset(0, 1)
            'weitersuchen (falls mehrfach vorhanden)
            Set rFind = Columns(3).FindNext(rFind)
            If rFind Is Nothing Then Exit Do
          Loop Until rFind.Address = Adr1
      End If
    Next AC

    Application.StatusBar = Empty
    Application.ScreenUpdating = True

    MsgBox n & "  gefunden Daten"
End Sub

[RoAdRuNnEr]

Sooooo......

ich denke es ist Vollbracht (ich hoffe es)

Ich habe nochmal ein Makro aufgezeichnet von Anfang bis zum Ende der Tabellenumstrukturierung und habe dabei immer Teilmakros gemacht
und diese in meinem eigentlichen Makro, nach positiven Ergebnis, inplementiert.

Nachdem die Ursprungstabelle wieder mal ein Update bekommen hat und 11 weitere Zeilen dazugekommen sind, war ich gespannt auf das
Ergebnis nachdem ich das Monster-Makro ausgeführt habe.

Nach Aktuellen Erkentnissen sieht es jetzt Endlich so aus, als wäre alles in Ordnung!

Selbst wenn die Ursprungstabelle jetzt in Zukunft nun erweitert wurde, ist, nach aktivieren meines Makros die End Tabelle so, wie ich es haben wollte.

Es war Wirklich für mich ein sehr langer Kampf bis dort hinzukommen und ich Danke Euch Wirklich sehr für Eure Hilfe !
Ohne Euch wäre ich schon frühzeitig gescheitert und hätte schon längst aufgegeben.

V I E L E N , V I E L E N   D a n k  !!!


Was jetzt noch ein wenig stört ist dieses Makro erst mal in Excel zu importieren, bevor ich es ausführen kann, denn ich habe es in *.bas abgespeichert.
Gibt es eine Möglichkeit dieses Makro Direkt beim Laden von Excel in der Makroliste zu haben? Also Ohne dazu eine Tabelle vorher Laden zu müssen, wo dieses Makro existiert ?

[Gast 123]

Hallo

freut mich das du es mit deiner Lösung soweit geschafft hast, alle Achtung.   Auf den Thread können alle Beteiligten stolz sein.
Zum Makro:  man kann das Makro als Text von einer Excel Datei aus dem Modul oder aus einer Tabelle als Text in die andere Datei kopieren. Ohne .bas zu importieren.
Steht das Makro als Text in der Tabelle (ohne Module) kannst du die Musterdatei auch als xlsx speichern. Ein Blatt reicht ja als Vorlage zum kopieren.

mfg Gast 123

[RoAdRuNnEr]

Ich denke, ich mache es auf die Weise, wie ich es gelernt habe.
Zumal ich nur beim Excel Start eine Leere Arbeitsmappe anwählen muß und dann mein Makro reinlade, denn in diesem Makro sind schon die Tabellen die ich für meine
Endtabelle brauche mit intigriert.

Würde jetzt gerne meine Tabelle in einer PDF Datei exportieren.
Das Problem dabei ist, daß die fertige PDF Datei ganz anders aussieht als meine Excel Tabelle.
Es sind nur pro Seite 2 Spalten zu sehen...das ist Natürlich Käse.

Gibt es eine Möglichkeit eine PDF Datei zu erstellen die Exakt so aussieht wie die Excel Tabelle ?
Also das wenn man sie öffnet alles schön in in Reihe tabellarisch zu sehen ist ?

Denn diese PDF Datei wird Online hochgeladen, sodaß Zuschauer meines streams sich diese anschauen können,...

[RoAdRuNnEr]

Nachtrag :

Das mit dem PDF konvertieren habe ich jetzt so geregelt, daß ein Externes Tool Namens "DoPdf" in Excel mehr Formate als die Standart Formate auch in Excel selbst anbietet.
Somit ist das 1 : 1 umsetzen von der Tabelle zur PDF kein Problem mehr. Wenn man dazu noch die Seitenränder alle 0 setzt hat man eine Schöne PDF Tabelle ohne Ränder (randlos).

Damit bin ich jetzt Endgültig zu meinem Ziel gekommen.

Thread kann damit geschlossen werden.

Vielen Dank nochmal für die Hilfe an alle Beteiligten.