Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1656to1660
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Recorderaufnahme verbessern

Recorderaufnahme verbessern
12.11.2018 10:48:57
Michael
Hallo, habe mit dem Recorder ein Makro aufgenommen. Der Code funktioniert zwar, aber nicht sehr zufrieden stellend. Nach dem durchlauf des Codes ist das Array immer noch ausgewählt. Was sehr störend ist. Hat jemand eine Idee wie es besser funktioniert?
Vielen Dank für eure Hilfe
  • 
    Sub Rekorder2()
    ' Schriftart und Größe einstellen
    Sheets(Array("Tabelle1_Kosten", "Tabelle2_Kosten", "Tabelle3_Kosten", _
    "Tabelle4_Kosten", "Tabelle5_Kosten", "Tabelle6_Kosten", _
    "Tabelle7_Kosten", "Tabelle8_Kosten", "Tabelle9_Kosten", _
    "Tabelle10_Kosten", "Tabelle11_Kosten", "Tabelle12_Kosten", _
    "Tabelle13_Kosten", "Tabelle14_Kosten", "Tabelle15_Kosten")).Select
    Rows("10:10").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Font
    .Name = "Calibri"
    .Size = 14
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .TintAndShade = 0
    .ThemeFont = xlThemeFontMinor
    End With
    End Sub
    

  • 31
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Recorderaufnahme verbessern
    12.11.2018 10:53:41
    Rainer
    Hallo Michael,
    Sheets("Tabelle1").Select
    
    Man könnte es natürlich auch ganz ohne ".Select" machen, aber dazu müsstest du dein Vorhaben genauer erklären.
    Gruß,
    Rainer
    Hallo Rainer
    12.11.2018 11:14:44
    Michael
    Erklären? Sorry ich dachte das das was passieren soll, im Code ersichtlich ist.
    Also: Auf allen "Kosten" Tabellenblättern soll ab Zeile 10 bis zum Ende aller Einträge die Schriftart auf "Calibri" Größe 14 festgelegt werden.
    Die Recorder Aufnahme tut das zwar zufrieden stellend, lässt das Array aber nach dem Durchlauf aktiviert. Das soll nicht sein.
    Absolut super wäre es noch wenn der Code auch gleich noch eine feine Pünktchen Linie unter alle Zeilen setzt die ab Zeile 10 gefunden werden.
    Hinweis: Die Anzahl der Einträge ab Zeile 10 sind auf jeder Seite unterschiedlich, aber auf jeder Seite 8 Spalten breit.
    Hoffe das das mein Anliegen erklärt.
    Gruß Michael
    Anzeige
    AW: Hallo Rainer
    12.11.2018 12:44:12
    Rainer
    Hallo Michael,
    Probiere mal diesem Code in einem Modul aus:
    Sub Zeile10()
    Dim ws As Worksheet
    Dim rngFound As Range
    For Each ws In Worksheets
    Err.Number = 0
    Z = ws.Name
    On Error Resume Next
    X = WorksheetFunction.Find("Kosten", Z)
    If Err.Number  0 Then
    X = 0
    Else    'Sheet mit "Kosten"
    letztezeile = ws.Cells(Rows.Count, 1).End(xlUp).Row
    letztespalte = ws.Cells(10, 256).End(xlToLeft).Column
    With ws.Range(Cells(10, 1), Cells(10, letztespalte)).Font
    .Name = "Calibri"
    .Size = 14
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .TintAndShade = 0
    .ThemeFont = xlThemeFontMinor
    End With
    If letztezeile > 10 Then
    With ws.Range(Cells(11, 1), Cells(letztezeile + 1, letztespalte)).Borders( _
    xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlHairline
    End With
    End If
    End If
    Next ws
    End Sub
    

    Anzeige
    AW: Hallo Rainer
    12.11.2018 15:47:12
    Michael
    Hallo Rainer
    Habe deinen Code ausprobiert. Leider passiert in meinen Tabellen nicht viel. Alles was passiert ist: Die Zelle A10 wird in Calibri 14 formatiert, und das auch nur auf dem ersten Blatt. Die anderen Tabellen werden überhaupt nicht angesprochen. Wenn ich die Zeile
    letztespalte = ws.Cells(10, 256).End(xlToLeft).Column
    

    in
    letztespalte = ws.Cells(10, 256).End(xlToRight).Column
    

    ändere, formatiert er alle Salten korrekt, aber leider nur in Zeile 10. Was Bedeutet eigentlich in der Zeile die 256?
    Irgend etwas scheint noch zu Haken. Linien werden nur eingefügt wenn ich letztezeile/letztespalte durch tatsächliche Bezüge wie 10, 1 / 500, 8 ersetze.
    Kannst du bitte nochmal drüber schauen?
    Vielen Dank für deine Hilfe
    Michael
    Anzeige
    AW: Hallo Rainer
    12.11.2018 16:51:08
    Rainer
    Hallo Michael,
    ist es möglich die Tabelle mit 2 Blättern hochzuladen?
    Anonymisiere die Daten darin, aber mache die Zellen nicht einfach leer (schreibe z.B. "x")
    Dann kann ich es besser testen.
    Außerdem noch deine Antwort "formatiert er alle Salten korrekt, aber leider nur in Zeile 10": Da sollen also alle Spalten ab Zeile 10 formatiert werden mit Calibri 14 und Punkten?
    Gruß,
    Rainer
    AW: Hallo Rainer
    12.11.2018 19:03:35
    Michael
    Hallo Rainer
    Anbei eine Beispielmappe, Im Reiter "so sollte es sein" ist alles Beschrieben. Hoffe ich jedenfalls.
    Gruß
    Michael
    https://www.herber.de/bbs/user/125344.xlsm
    Anzeige
    AW: Hallo Rainer
    12.11.2018 22:49:15
    Michael
    Vergessen den Haken zu setzen
    AW: Hallo Rainer
    12.11.2018 23:35:14
    Rainer
    Hallo Michael,
    Probiere mal diesen Code. Ich hatte einen sehr dummen Fehler eingebaut.
    Es stand da:
    With ws.Range(Cells(10, 1), Cells(10, letztespalte)).Font
    

    und richtig ist:
    With ws.Range(ws.Cells(10, 1), ws.Cells(10, letztespalte)).Font
    
    Darum funktionierte der Code nur, wenn das Sheet ausgewählt ist. War es natürlich zum Testen...
    Ich habe es geändert und an deine Vorlage angepasst. Jetzt wird ab Zeile 20 formatiert, nicht mehr ab Zeile 11.
    Um noch deine Frage zu beantworten zu folgendem Code:
    letztespalte = ws.Cells(10, 256).End(xlToLeft).Column
    
    Das ist schon richtig so, ist nur CopyPaste von https://www.excel-inside.de/vba-loesungen/zellen-a-bereiche/337-letzte-zeile-letzte-spalte-und-letzte-zelle-per-vba-ermitteln
    Es wird beginnend in Spalte 256 nach links gesucht, die erste Spalte welche nicht leer ist. Also das gleiche, als würde man STRG + LINKS drücken. Die 256 ist vermutlich ein Relikt von älteren Office Versionen, als es noch nicht mehr Spalten gab.
    Hier der neue Code, bitte mal testen und berichten was noch klemmt.
    Sub Zeile10()
    Dim ws As Worksheet
    Dim rngFound As Range
    For Each ws In Worksheets
    Err.Number = 0
    Z = ws.Name
    On Error Resume Next
    X = WorksheetFunction.Find("Kosten", Z)
    If Err.Number  0 Then
    X = 0
    Else    'Sheet mit "Kosten"
    letztezeile = ws.Cells(Rows.Count, 1).End(xlUp).Row
    letztespalte = ws.Cells(10, 256).End(xlToLeft).Column
    'Formatiere Zeile 10
    With ws.Range(ws.Cells(10, 1), ws.Cells(10, letztespalte)).Font
    .Name = "Calibri"
    .Size = 14
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .TintAndShade = 0
    .ThemeFont = xlThemeFontMinor
    End With
    If letztezeile > 19 Then
    letztespalte = ws.Cells(20, 256).End(xlToLeft).Column
    'Formatiere Bereich unter Zeile 19
    With ws.Range(ws.Cells(20, 1), ws.Cells(letztezeile + 1, letztespalte))
    With .Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlHairline
    End With
    With .Font
    .Name = "Calibri"
    .Size = 14
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .TintAndShade = 0
    .ThemeFont = xlThemeFontMinor
    End With
    End With
    End If
    End If
    Next ws
    End Sub
    

    Anzeige
    AW: Hallo Rainer
    13.11.2018 22:56:45
    Michael
    Hallo Rainer
    Sorry für die späte Rückmeldung, ich war mit einem LKW unterwegs und konnte nicht eher.
    Habe mir deinen Code angeschaut. Läuft jetzt einwandfrei über alle Seiten. Werde deinen Code mal in meiner Original Mappe testen. Den Teil nach 'Formatiere Zeile 10 kann man doch getrost löschen, oder sehe ich das falsch?
    Vielen Dank für deine Hilfe und viele Grüße
    Michael
    AW: Hallo Rainer
    14.11.2018 00:13:54
    Rainer
    Hallo Michael,
    warum willst du es denn löschen und was genau?
    Vermutlich brauchst du aus der With Schleife nur die Parameter .Name und .Size für Zeile 10.
    Ab Zeile 20 reicht vermutlich ebenfalls .Name und .Size für die Schleife With .Font. Bei With .Borders würde ich es so lassen, das macht deine gepunkteten Linien.
    Zum Test kannst du in VBA die Zeilen mit Hochkomma auskommentieren, dann werden sie grün und nicht mehr ausgeführt. Wenn der Code dann immer noch das macht, was du willst, dann kannst du es auch löschen. Aber kommt es echt auch ein paar Byte Größe und Millisekunden Ausführungszeit an? Dann lieber so:
    
    ‘Get current state of various Excel settings; put this at the beginning of your code
    screenUpdateState = Application.ScreenUpdating
    statusBarState = Application.DisplayStatusBar
    calcState = Application.Calculation
    eventsState = Application.EnableEvents
    ‘turn off some Excel functionality so your code runs faster
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ‘>>your code goes here
    Gruß,
    Rainer
    Anzeige
    AW: Hallo Rainer
    14.11.2018 09:42:10
    Michael
    Hallo Rainer
    Mit dem Teil meinte ich:
      'Formatiere Zeile 10
    With ws.Range(ws.Cells(10, 1), ws.Cells(10, letztespalte)).Font
    .Name = "Calibri"
    .Size = 14
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .TintAndShade = 0
    .ThemeFont = xlThemeFontMinor
    End With
    
    So wie ich das sehe, Formatiert dieser Teil nur die Zeile 10 in "Calibri 14". Zumindest war das bei meiner Probe so. Bei einem zweiten Versuch hatte ich diesen Bereich mit Hochkommas versehen, und es lief trotzdem prächtig. Im Bereich Zeilen 1 bis 19 sollte ja auch nichts passieren. Der Bereich ab Zeile 20 wird ja erst im unteren Code Teil angesprochen. Es geht mir in dieser Beziehung auch nicht um ein paar Millisekunden, sondern um das Verständnis dessen, womit mir geholfen wurde. Einen Code in ein Modul zu setzen, den ein anderer geschrieben hat, ist recht einfach. Ich möchte ihn aber auch verstehen, um nicht ständig mit den gleichen Anliegen, andere zu Nerven. Wenn ich ihn verstehe, schaffe ich es das nächste mal vielleicht selbst, etwas zu schreiben, das auch läuft.
    Viele Grüße aus Niedersachsen
    Michael
    Anzeige
    AW: Hallo Rainer
    14.11.2018 11:58:07
    Rainer
    Hallo Michael,
    in deiner originalen Aufgabenstellung ging es um Zeile 10. Wenn das nun obsolet ist, dann weg damit.
    Gibt es noch mehr Klarheiten zu beseitigen?
    Gruß,
    Rainer
    AW: Hallo Rainer
    14.11.2018 12:48:57
    Michael
    Hallo Rainer
    Sorry für das Missverständnis, in der Beispielmappe hatte ich angegeben das alles erst ab Zeile 20 laufen sollte, aber es stimmt, in der Erstanfrage war von Zeile 10 die Rede.
    Hab den Teil rausgenommen, und alles Gut.
    Vielen Dank
    Michael
    AW: Hallo Rainer
    14.11.2018 19:35:00
    Rainer
    Dann viel Spaß damit!
    Application.CutCopyMode=False am Schluss (owT)
    12.11.2018 11:22:29
    EtoPHG

    AW: Application.CutCopyMode=False am Schluss (owT)
    12.11.2018 11:32:49
    Herbert
    Hallo Hansueli,
    aber er kopiert doch garnix!
    @Michael: Wobei es völliger Quatsch ist, ein ganze Zeile, sowie alle Zeilen bis 1.048576 zu formatieren! Das solltest du deutlich einschränken!
    Servus
    Anzeige
    Sorry, Schnellschuss an den falschen Ort ;-) (owT)
    12.11.2018 11:46:48
    EtoPHG

    AW: Sorry, Schnellschuss an den falschen Ort ;-) (owT)
    12.11.2018 12:02:19
    Herbert
    Hallo Hansueli,
    ist doch nicht tragisch! Lieber einmal nicht ganz korrekt geantwortet, als gar nicht!
    Servus
    Danke
    12.11.2018 12:01:29
    Michael
    Danke für die vielen Antworten an Alle.
    Habe mich jetzt auf einen Bereich A10:M500 beschränkt.
    Kann man den Bereich nicht auch auf jeder Seite derart begrenzen, das nur die Zellen mit Text Formatiert werden. Geht das Beenden der Array Selection tatsächlich nur über Range eines Sheets außerhalb des Arrays? Und wie baue ich noch die Pünktchen Linie mit ein?
    Gruß
    Michael
    AW: Danke
    12.11.2018 13:00:00
    Herbert
    Hallo Michael,
    mit dem nachfolgenden Code kannst du die Zellformatierungen für alle selektierten Arbeitsblätter setzen und für das erste AB auch die Linien. für die restl. AB müsstest du die Linien manuell setzen. Jedenfalls weiß ich dafür keinen Code. Vielleicht weiß ja ein Anderer noch eine Lösung.
    Sub Rekorder2()
    Dim loErsteZeile&, loLetzteZeile&, loLetzteSpalte&
    loErsteZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    loLetzteZeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    loLetzteSpalte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
    Sheets(Array("Tabelle1_Kosten", "Tabelle2_Kosten", "Tabelle3_Kosten", _
    "Tabelle4_Kosten", "Tabelle5_Kosten", "Tabelle6_Kosten", _
    "Tabelle7_Kosten", "Tabelle8_Kosten", "Tabelle9_Kosten", _
    "Tabelle10_Kosten", "Tabelle11_Kosten", "Tabelle12_Kosten", _
    "Tabelle13_Kosten", "Tabelle14_Kosten", "Tabelle15_Kosten")).Select
    With Range(Cells(loErsteZeile, 1), Cells(loLetzteZeile, loLetzteSpalte)).Font
    .Name = "Calibri"
    .Size = 14
    End With
    With Range(Cells(loErsteZeile, 1), Cells(loLetzteZeile, loLetzteSpalte)).Borders( _
    xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlHairline
    End With
    With Range(Cells(loErsteZeile, 1), Cells(loLetzteZeile, loLetzteSpalte)).Borders( _
    xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlHairline
    End With
    Range("A1").Select
    ActiveSheet.Previous.Select
    End Sub
    
    Servus
    Anzeige
    AW: Danke
    12.11.2018 15:55:18
    Michael
    Hallo Herbert
    Habe deinen Code ausprobiert. Bekomme aber die Fehlermeldung das Sheets(Array.... außerhalb des Index ist. Widerspricht sich eigentlich nicht die Deklaration ActiveSheet mit dem Sheets(Array... von vornherein, oder ist das von mir falsch gedacht?
    Vielen Dank für deine Hilfe
    Michael
    AW: Danke
    12.11.2018 16:38:00
    Herbert
    Hallo Michael,
    da du uns ja nicht gesagt hast, in welchem Sheet du den zu formatierenden Bereich (A10:M500) festlegen willst, habe ich angenommen, dass es im aktiven Sheet ist! Wenn du den Bereich in jedem Sheet separat festlegen willst, musst du eine "For ... Next" - Schleife einbauen!
    Ansonsten wäre es sehr hilfreich, wenn du mal eine Beispieldatei hochladen würdest!
    Servus
    AW: Danke
    12.11.2018 19:03:30
    Michael
    Hallo Herbert
    Anbei eine Beispielmappe, Im Reiter "so sollte es sein" ist alles Beschrieben. Hoffe ich jedenfalls.
    Gruß
    Michael
    https://www.herber.de/bbs/user/125344.xlsm
    AW: Danke
    13.11.2018 16:04:19
    Herbert
    Hallo Michael,
    schau dir meinen neuen Code in deiner AM mal an. Dieser läuft nun alle AB der Reihe nach durch und immer wenn er auf ein AB mit dem Namensinhalt "_Kosten" trifft, ermittelt er die letzte belegte Spalte, sowie die erste und letzte belegte Zeile. Anschließend formatiert er diesen Bereich mit den gewünschten Fontangaben und setzt die dünne Linie. Probier's mal.
    https://www.herber.de/bbs/user/125362.xlsm
    Servus
    AW: Danke
    13.11.2018 22:42:43
    Michael
    Hallo Herbert
    Sorry für die späte Rückmeldung, ich war mit einem LKW unterwegs und konnte nicht eher.
    Habe mir deinen Code angeschaut. Läuft jetzt gut über alle Seiten. Der einzige Haken den es evtl. noch gibt, ist das die Hairline und die Formatierung auf allen Seiten den gleichen Umfang hat. Und zwar so, wie auf der längsten Seite. Werde deinen Code mal in meiner Original Mappe testen, und wenn mein Code für die Druckseiten Einrichtung nicht über die zu lang Formatierten Bereiche stolpert, ist es gut. Ansonsten melde ich mich nochmals.
    Vielen Dank für deine Hilfe und viele Grüße
    Michael
    AW: Danke
    14.11.2018 09:54:23
    Michael
    Hallo Herbert
    Läuft jetzt Perfekt. Werde mir nachher mal die unterschiede zu vorher genau anschauen, um zu erkennen worauf man beim Schreiben achten muss, und wie es besser geht. Nun habe ich 2 perfekt laufende Lösungswege. Aber wie heißt es doch so schön: "Wer die Wahl hat, hat die Qual"
    Vielen Dank für deine ausgiebige Hilfe
    Viele Grüße aus Niedersachsen
    Michael
    AW: Danke
    14.11.2018 09:58:33
    Herbert
    Hallo Michael,
    der Fehler von vorher lag daran, dass ich alle 3 AB und dann den Bereich bis Zeile 140 markiert habe. Damit war die "UsedRange" in allen 3 AB gleich bis 140. Ich habe also die leeren Zeilen in den beiden kleineren AB entfernt und dann auch einen anderen Befehl zur Ermittlung der letzten, belegten Zeile verwendet. Denn wie du gesehen hast, ist der "UsedRange"-Befehl manchmal falsch.
    Servus
    AW: Recorderaufnahme verbessern
    12.11.2018 11:23:09
    Herbert
    Hallo Michael,
    da du ja "selectiert" hast, bleibt die Selection so lange bestehen, bis du den Cursor mit "Range("A1").select" in die angegebene Zelle (etc.) schickst.
    Servus
    AW: Recorderaufnahme verbessern
    12.11.2018 12:08:53
    Rainer
    Hallo Herbert Grom,
    er hat ein Array von Tabellen selektiert. Da hilft eine Änderung am Cursor auch nicht. Er muss ein Tabellenblatt selektieren.
    Ich schau mir sein Vorhaben mal an, aber ohne Beispieldatei braucht es etwas länger.
    AW: Recorderaufnahme verbessern
    12.11.2018 12:10:15
    Herbert
    Hallo Rainer,
    da hast du nun wieder recht, das hatte ich übersehen! Danke für den Hinweis.
    Servus

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige