aufgezeichnetes Makro in allen Tabellenblättern au
01.06.2008 21:36:00
Jörg
als VBA Neuling muss ich umfangreiche Messdaten aufbereiten. Diese sind in .txt Files hinterlegt. Alle Files in einem Ordner sollen in einer Arbeitsmappe abgelegt werden, wobei jedes File in einem eigenen Arbeitsblatt landen soll. Für diese Funktion habe ich hier bereits eine entsprechende Lösung gefunden.
Nun soll aus für jedes Arbeitsblatt der Mittelwert und die Standardabweichung sowie ein Diagramm der Daten erstellt werden. Dies habe ich nun mittels Makrorekorder einmal aufgezeichnet. Wie muss ich das makro anpassen, damit es für alle Arbeitsblätter der Mappe unabhängig von deren Namen durchgeführt wird?
Sub Diagramm()
' Diagramm Makro
' Makro am 28.05.2008 von Jörg User aufgezeichnet
Sheets("1400").Select
Rows("101:400").Select
Selection.ClearContents
Range("A111").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-110]C:R[-11]C)"
Range("A111").Select
Selection.Copy
Range("B111:AF111").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=9
Range("A111:AF111").Select
Application.CutCopyMode = False
Range("A113").Select
ActiveCell.FormulaR1C1 = "=STDEV(R[-112]C:R[-13]C)"
Range("A113").Select
Selection.Copy
Range("B113:AF113").Select
ActiveSheet.Paste
Range("AG90").Select
Application.CutCopyMode = False
Charts.Add
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=Sheets("1400").Range("O1:O100"), PlotBy:= _
xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="1400"
With ActiveChart
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Anzahl Scans"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Entfernung [mm]"
End With
ActiveChart.HasLegend = False
ActiveChart.HasDataTable = False
ActiveSheet.Shapes("Diagramm 1").ScaleWidth 1.23, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Diagramm 1").ScaleHeight 1.24, msoFalse, _
msoScaleFromTopLeft
ActiveChart.Axes(xlCategory).Select
Windows("080528_Papier_Fir_7_2.xls").SmallScroll Down:=12
End Sub
Danke schon mal für eure hilfe,
Gruss Jörg