Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
252to256
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
252to256
252to256
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro-Aufzeichnung als VBA erweitern

Makro-Aufzeichnung als VBA erweitern
11.05.2003 12:27:33
Franz
Hallo Exceexperten
nach vielen Versuchen habe ich es als Neuling geschaftt, ein Makro aufzuzeichnen und für dieses Abreibtsblatt ablaufen zu lassen.
Wie muss ich das Makro erweitern / verfeinern, damit ich alle neuen Tabellen, die den gleichen Aufbau, aber unterschiedliche Zeilenanzahlen haben, anwenden kann?
Wie kann die Abfrage angehalten werden, wenn die Suche nach PositionsNr. abnimmt (von 9.9.9.9 auf 9.9.9.8?
Die Vorgabe ist für jede Tabelle
in Spalte E "Summe Gruppe 1.1" (kann theoretisch gehen bis "Summe Gruppe 9.9.9.9")
hier meine Makroaufzeichnung:
Sub ZusaFassung()
'
' ZusaFassung Makro
'

'
ActiveWindow.Panes(1).Activate
Range("A1").Select
Cells.Find(What:="gesamt", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Range("E727").Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
ActiveWindow.Panes(3).Activate
Range("A727").Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
Range("E729").Select
ActiveCell.FormulaR1C1 = "Zusammenfassung"
Range("E728:I729").Select
Range("E729").Activate
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
With Selection.Font
.Name = "Times New Roman"
.FontStyle = "Fett"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveWindow.Panes(1).Activate
Range("A1").Select
Cells.Find(What:="Summe Gruppe", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Rows("52:53").Select
Selection.RowHeight = 13.5
Selection.RowHeight = 15
Rows("52:53").EntireRow.AutoFit
Rows("52:54").Select
Selection.Copy
ActiveWindow.Panes(3).Activate
Rows("731:731").Select
Selection.Insert Shift:=xlDown
ActiveWindow.Panes(1).Activate
Range("A54").Select
Cells.FindNext(After:=ActiveCell).Activate
Rows("129:131").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=5
ActiveWindow.Panes(3).Activate
Rows("734:734").Select
Selection.Insert Shift:=xlDown
ActiveWindow.SmallScroll Down:=4
ActiveWindow.Panes(1).Activate
Range("A131").Select
Cells.FindNext(After:=ActiveCell).Activate
Rows("158:160").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.Panes(3).Activate
Rows("737:737").Select
Selection.Insert Shift:=xlDown
ActiveWindow.Panes(1).Activate
Range("A160").Select
Cells.FindNext(After:=ActiveCell).Activate
Rows("279:281").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.Panes(3).Activate
Rows("740:740").Select
Selection.Insert Shift:=xlDown
ActiveWindow.Panes(1).Activate
Range("A281").Select
Cells.FindNext(After:=ActiveCell).Activate
Rows("688:690").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=5
ActiveWindow.Panes(3).Activate
Rows("743:743").Select
Selection.Insert Shift:=xlDown
ActiveWindow.Panes(1).Activate
Range("A690").Select
Cells.FindNext(After:=ActiveCell).Activate
Rows("701:703").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=2
ActiveWindow.Panes(3).Activate
Rows("746:746").Select
Selection.Insert Shift:=xlDown
Selection.FindNext(After:=ActiveCell).Activate
ActiveWindow.Panes(1).Activate
Range("A703").Select
Cells.FindNext(After:=ActiveCell).Activate
Rows("710:712").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=4
ActiveWindow.Panes(3).Activate
Rows("749:749").Select
Selection.Insert Shift:=xlDown
ActiveWindow.SmallScroll Down:=4
Range("E753").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Gesamt"
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Times New Roman"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("F753").Select
ActiveCell.FormulaR1C1 = _
"=SUM(R[-4]C:R[-1]C,R[-7]C,R[-10]C,R[-13]C,R[-16]C,R[-19]C,R[-22]C)"
Range("F753").Select
Selection.Copy
Range("G753").Select
Range(Selection, Selection.End(xlToRight)).Select
ActiveSheet.Paste
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.LargeScroll ToRight:=-20
ActiveWindow.SmallScroll ToRight:=2
Rows("753:753").Select
Range("C753").Activate
With Selection.Font
.Name = "Times New Roman"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Rows("753:753").Select
Range("C753").Activate
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Range("E753").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$5"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "IWA Wiethoff"
.CenterFooter = ""
.RightFooter = "Seite -&P -"
.LeftMargin = Application.InchesToPoints(0.787401575)
.RightMargin = Application.InchesToPoints(0.787401575)
.TopMargin = Application.InchesToPoints(0.984251969)
.BottomMargin = Application.InchesToPoints(0.984251969)
.HeaderMargin = Application.InchesToPoints(0.4921259845)
.FooterMargin = Application.InchesToPoints(0.4921259845)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
End With
End Sub

Herzlichen Dank
Franz

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Makro-Aufzeichnung als VBA erweitern
11.05.2003 13:43:51
Ramses

Hallo Franz,

schön, dass du dich mit Makros beschäftigst ;-),... aber das ist ein bischen viel verlangt.
Das Forum hat keine Ahnung wie deine Tabelle aufgebaut ist und was du machen willst.
Ich denke es ist nachvollziehbar, wenn sich keiner die Mühe macht das Makro auszutesten und zu schauen was dann passiert.

Schildere in kurzen Worten was du für eine Vorgabe hast und was du machen willst,... dann kommen wir sicher schneller und eher zum Ziel.

Gruss Rainer

Re: Makro-Aufzeichnung als VBA erweitern
11.05.2003 13:43:53
Ramses

Hallo Franz,

schön, dass du dich mit Makros beschäftigst ;-),... aber das ist ein bischen viel verlangt.
Das Forum hat keine Ahnung wie deine Tabelle aufgebaut ist und was du machen willst.
Ich denke es ist nachvollziehbar, wenn sich keiner die Mühe macht das Makro auszutesten und zu schauen was dann passiert.

Schildere in kurzen Worten was du für eine Vorgabe hast und was du machen willst,... dann kommen wir sicher schneller und eher zum Ziel.

Gruss Rainer

Anzeige
Re: Makro-Aufzeichnung als VBA erweitern
11.05.2003 19:14:10
Franz

Sorry, die Fragestellung ist wirklich unklar.
Ich möchte in Tabellen, die viele Positionen enthalten und durch Zwischensummen ( Summe Gruppe 1.1; 1.2.1.1 ... bis Summe Gruppe 9.9.9.9)getrennt sind, die Zwischensummen suchen lassen und die Zwischensummen-Zeilen kopieren und am Tabellenende in einer Zusammenfassung darstellen.
Das Ende des Suchvorganges soll erreicht sein, wenn die Aufzählung der Zwischensumme kleiner als der Vorgänger wird (Summe Gruppe von 9.9.9.9 wieder rückwärts geht auf beispielhaft 9.9.9.8)

Ich hoffe, dieses ist etwas verständlicher.
Danke für Eure Nachsicht und Mühe
Franz

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige