Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1520to1524
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

Auswertung gleicher Tabellen in einer Excel

Auswertung gleicher Tabellen in einer Excel
21.10.2016 13:22:14
Tim
Hallo ihr Excel-Fachleute,
ich habe folgendes Problem. Ich möchte gerne eine Excel mit dem Namen 00_Auswertung_Drucktest.xlsx mit Messdaten befüllen. Einmal pro Messtag nehme ich eine .xls Datei damit auf. Aus einem anderen Makro weiß ich, dass das nur eine verkappte Excel ist.

Dim WB As Workbook, wksXLS As Worksheet, wksLOG As Worksheet, wksDIA As Worksheet
Dim iXLS As String
Set WB = Application.Workbooks.Open(iXLS, ReadOnly:=True, Local:=True)
Set wksXLS = WB.Sheets(WB.Sheets.Count)

Die Excel wird nach diesem Raster bearbeitet:

' xls-Bearbeitung
With wksXLS
.Select
.Columns("A:A").EntireColumn.AutoFit
.Columns("C:C").EntireColumn.AutoFit
.Columns("E:E").EntireColumn.AutoFit
.Columns("G:G").EntireColumn.AutoFit
Application.CutCopyMode = False
With .Range("B3:H3")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Range("B3:H3").Merge
.Range("A7").Delete Shift:=xlToLeft
With .Range(Rows(6), .Rows(6))
.WrapText = True
.VerticalAlignment = xlCenter
.AutoFit
End With
lngCol = .UsedRange.Column + .UsedRange.Columns.Count - 1
rng = .Cells(.Rows.Count, 1).End(xlUp).Row
With .Range(.Cells(7, 2), .Cells(rng, lngCol))
.NumberFormat = "0.000;-0.000;0.000;@"
End With
' Zeit in Sekunden
.Range("B7").FormulaR1C1 = "=((R[1]C[-1])-R[1]C[-1])*86400"
.Range("B7").NumberFormat = "General"
.Range("B8").FormulaR1C1 = "=((R[0]C[-1]-R[-1]C[-1])*86400)+R[-1]C"
.Range("B8").NumberFormat = "General"
rng = .Cells(.Rows.Count, 3).End(xlUp).Row
.Range("B8").AutoFill Destination:=.Range(.Cells(8, 2), .Cells(rng, 2)), _
Type:=xlFillDefault
End With
Range("C7").Select
ActiveWindow.FreezePanes = True

Die Messdaten sollen jeweils in einem neuen Worksheet angelegt werden. Auf Worksheet 1 sollen dann Mittelwert automtisch berechnet werden sobald mit dem Makro ein neues Worksheet angehängt worden ist. Dazu gibt via Makro Recorder folgendes "Makro":

ActiveCell.FormulaR1C1 = "=Tabelle2!R[-2]C[-2] & "" "" &Tabelle2!R[-2]C[-1]"
Range("D3").Select
ActiveCell.FormulaR1C1 = "=Tabelle2!R[-2]C[-2]"
Range("C3").Select
ActiveCell.FormulaR1C1 = "=Tabelle2!R[-2]C[-2]"
Range("C4").Select
ActiveCell.FormulaR1C1 = "=Tabelle2!R[2]C[14]"
Range("C4").Select
Selection.AutoFill Destination:=Range("C4:D4"), Type:=xlFillDefault
Range("C4:D4").Select
Range("C5").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Tabelle2!R[2]C[14]:R[64]C[14])"
Range("C5").Select
Selection.AutoFill Destination:=Range("C5:D5"), Type:=xlFillDefault
Range("C5:D5").Select
Range("C6").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Tabelle2!R[64]C[14]:R[123]C[14])"
Range("C6").Select
Selection.AutoFill Destination:=Range("C6:D6"), Type:=xlFillDefault
Range("C6:D6").Select
Range("C7").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Tabelle2!R[124]C[14]:R[243]C[14])"
Range("C7").Select
Selection.AutoFill Destination:=Range("C7:D7"), Type:=xlFillDefault
Range("C7:D7").Select

Hier ist die Drucktestdatei:
https://www.herber.de/bbs/user/108948.xlsx
Ich habe eine Messdatei da hinein kopiert als Beispiel.
Ich hoffe es ist nachvollziehbar und ihr habt eine gute Idee zur Lösung!
Vielen Dank
Tim

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Auswertung gleicher Tabellen in einer Excel
22.10.2016 00:51:14
Piet
Hallo Tim,
den Code des Makrorecorder kann man zusammenfassen auf Select verzichten. Die erste Zelle ist unklar!
Den Rest habe ich nicht verstanden. Vielleicht erkennt ein anderer das Problem. Viel Glück.
mfg Piet
ActiveCell.FormulaR1C1 = "=Tabelle2!R[-2]C[-2] & "" "" &Tabelle2!R[-2]C[-1]"
Range("D3").FormulaR1C1 = "=Tabelle2!R[-2]C[-2]"
Range("C3").FormulaR1C1 = "=Tabelle2!R[-2]C[-2]"
Range("C4").FormulaR1C1 = "=Tabelle2!R[2]C[14]"
Range("C4").AutoFill Destination:=Range("C4:D4"), Type:=xlFillDefault
Range("C5").FormulaR1C1 = "=AVERAGE(Tabelle2!R[2]C[14]:R[64]C[14])"
Range("C5").AutoFill Destination:=Range("C5:D5"), Type:=xlFillDefault
Range("C6").FormulaR1C1 = "=AVERAGE(Tabelle2!R[64]C[14]:R[123]C[14])"
Range("C6").AutoFill Destination:=Range("C6:D6"), Type:=xlFillDefault
Range("C7").FormulaR1C1 = "=AVERAGE(Tabelle2!R[124]C[14]:R[243]C[14])"
Range("C7").AutoFill Destination:=Range("C7:D7"), Type:=xlFillDefault

Anzeige
AW: Auswertung gleicher Tabellen in einer Excel
22.10.2016 11:32:01
Tim
Danke dafür schon einmal. Habe ich das Problem nicht ausreichend verstanden oder hast du keine Idee (soll keine Kritik sein ;) )
LG
Tim
AW: Auswertung gleicher Tabellen in einer Excel
22.10.2016 11:32:57
Tim
verstanden = beschrieben
AW: Auswertung gleicher Tabellen in einer Excel
22.10.2016 19:58:25
fcs
Hallo Tim,
so ganz klar ist noch nicht alles.
1. Soll das Einfügen der Formeln im 1. Tabellenblatt immer in der gleichen Zelle beginnen?
Wenn JA, welche Zelle? C3
Oder muss hier die Startzelle irgendedwie variabel ermittelt werden?
z.B. immer nach rechts anbauen beginnend in Zeile 3
2. Sollen die Mittelwerte für die Werte aus dem letzten Tabellenblatt immer in Schritten von 60 Zeilen (entsprechend ca. 2 minuten) ermittelt werden, beginnend in Zeile 7 bis zum Ende der Liste?
Oder willst du fix mit den 3 von dir aufgezeichneten Zeilenwerten arbeiten?
LG
Franz
Anzeige
AW: Auswertung gleicher Tabellen in einer Excel
23.10.2016 08:01:27
Tim
Guten Morgen!
Also ich versuche es noch mal besser zu beschreiben:
1. Es sollen die "Messdaten" immer in Zelle A1 eines neuen Tabellenblatts geschrieben werden
2. Es sollen 3 Mittelwerte berechnet werden immer im Abstand von ca. 2 Minuten (120s, 240s,360s). Das Zeitraster bleibt immer gleich von daher würde ich die Umsetzung bevorzugen die Leichter zu programmieren ist.
Die Ergebnisse der jeweiligen "Messdaten" dann immer eine Spalte weiter auf dem ersten Tabellenblatt. Protokoll1 Spalte C, Protokoll2 Spalte D, usw.
LG
Tim
AW: Auswertung gleicher Tabellen in einer Excel
23.10.2016 16:11:44
fcs
Hallo Tim,
so sollte es etwa funktionieren.
Die Zweisung des Dateinamens zur Variablen iXLS musst du halt noch einbauen.
Beim Erzeugen der Formeln ist es einfacher mit absoluten Bezügen zu arbeiten statt mit relativen Bezügen.
LG
Franz
Sub aaTest()
Dim WB As Workbook, wksXLS As Worksheet, wksLOG As Worksheet, wksDIA As Worksheet
Dim iXLS As String
Dim lngCol As Long, rng As Long
Dim WBziel As Workbook, wksZiel As Worksheet, varZiel As Variant
Dim Spa_Z As Long, Zei_Z As Long, Zei_Q As Long, AnzZei As Long
Dim strSheet As String
'Zieldatei setzen und ggf. öffnen
varZiel = "00_Auswertung_Drucktest.xlsx"
For Each WBziel In Application.Workbooks
If LCase(WBziel.Name) = LCase(varZiel) Then
Exit For
End If
Next
If WBziel Is Nothing Then
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte Zieldatei für Messdaten auswählen/öffnen"
.InitialFileName = varZiel
If .Show = -1 Then
Set WBziel = Workbooks.Open(Filename:=.SelectedItems(1))
Else
Exit Sub
End If
End With
End If
iXLS = ActiveWorkbook.Path & "\" & "Tim108948.xlsx"    'Testzeile - iXLS musst du _
einen entsprechenden Dateinamen zuweisen  !!!!!!!!!!!!!
Set WB = Application.Workbooks.Open(iXLS, ReadOnly:=True, Local:=True)
Set wksXLS = WB.Sheets(WB.Sheets.Count)
'Die Excel wird nach diesem Raster bearbeitet:
' xls-Bearbeitung
With wksXLS
.Select
.Columns("A:A").EntireColumn.AutoFit
.Columns("C:C").EntireColumn.AutoFit
.Columns("E:E").EntireColumn.AutoFit
.Columns("G:G").EntireColumn.AutoFit
Application.CutCopyMode = False
With .Range("B3:H3")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Range("B3:H3").Merge
.Range("A7").Delete Shift:=xlToLeft
With .Range(Rows(6), .Rows(6))
.WrapText = True
.VerticalAlignment = xlCenter
.AutoFit
End With
lngCol = .UsedRange.Column + .UsedRange.Columns.Count - 1
rng = .Cells(.Rows.Count, 1).End(xlUp).Row
With .Range(.Cells(7, 2), .Cells(rng, lngCol))
.NumberFormat = "0.000;-0.000;0.000;@"
End With
' Zeit in Sekunden - Formel vereinfacht.
.Range("B7").NumberFormat = "General"
.Range("B7").Value = 0
rng = .Cells(.Rows.Count, 3).End(xlUp).Row
With .Range(.Cells(8, 2), .Cells(rng, 2))
.FormulaR1C1 = "=(R[0]C[-1]-R7C[-1])*86400"
.NumberFormat = "General"
End With
.Calculate
End With
Range("C7").Select
ActiveWindow.FreezePanes = True
'Messdaten-Blatt ans Ende der Zieldatei kopieren
With WBziel
wksXLS.Copy After:=.Sheets(.Sheets.Count)
strSheet = "'" & .Sheets(.Sheets.Count).Name & "'" 'Name in Formel
Set wksZiel = .Sheets(1)
End With
'Formeln im 1. Blatt ab Zeile 3 nach rechts einfügen
With wksZiel
Zei_Z = 3 'Zeile mit Protokoll/Datum
'nächste freie Spalte in der Zeile
Spa_Z = .Cells(Zei_Z, .Columns.Count).End(xlToLeft).Column + 1
If Spa_Z 

Anzeige
AW: Auswertung gleicher Tabellen in einer Excel
24.10.2016 12:07:42
Tim
Hi Franz,
danke der Code ist super. Habe ihn jetzt so angepasst, sodass ich mir, meiner Meinung nach, überflüssiges Klicken sparen kann.
Sub Schaltfläche2_Klicken()
Dim WB As Workbook, wksXLS As Worksheet
Dim iXLS As String
Dim lngCol As Long, rng As Long
Dim geoeffnet As Boolean
Dim WBziel As Workbook, wksZiel As Worksheet, varZiel As Variant
Dim Spa_Z As Long, Zei_Z As Long, Zei_Q As Long, AnzZei As Long
Dim strSheet As String
'Feststellen, ob eine der offenen Mappen "00_Auswertung_Drucktest.xlsx" heißt
For Each WBziel In Application.Workbooks
If WBziel.Name = "00_Auswertung_Drucktest.xlsx" Then geoeffnet = True
Next WBziel
'entsprechend reagieren
If geoeffnet Then
Workbooks("00_Auswertung_Drucktest.xlsx").Activate
Else
Set WBziel = Workbooks.Open("D:\Eigene Dateien\Messdaten\00_Auswertung_Drucktest.xlsx",  _
Local:=True)
End If
If WB Is Nothing Then
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte Messdatei wählen"
'            .InitialFileName = varZiel
If .Show = -1 Then
Set WB = Workbooks.Open(filename:=.SelectedItems(1), Local:=True)
Else
Exit Sub
End If
End With
End If
Set wksXLS = WB.Sheets(WB.Sheets.Count)
'Die Excel wird nach diesem Raster bearbeitet:
' xls-Bearbeitung
With wksXLS
.Select
.Columns("A:A").EntireColumn.AutoFit
.Columns("C:C").EntireColumn.AutoFit
.Columns("E:E").EntireColumn.AutoFit
.Columns("G:G").EntireColumn.AutoFit
Application.CutCopyMode = False
With .Range("B3:H3")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Range("B3:H3").Merge
.Range("A7").Delete Shift:=xlToLeft
With .Range(Rows(6), .Rows(6))
.WrapText = True
.VerticalAlignment = xlCenter
.AutoFit
End With
lngCol = .UsedRange.Column + .UsedRange.Columns.Count - 1
rng = .Cells(.Rows.Count, 1).End(xlUp).Row
With .Range(.Cells(7, 2), .Cells(rng, lngCol))
.NumberFormat = "0.000;-0.000;0.000;@"
End With
' Zeit in Sekunden - Formel
.Range("B7").NumberFormat = "General"
.Range("B7").Value = 0
rng = .Cells(.Rows.Count, 3).End(xlUp).Row
With .Range(.Cells(8, 2), .Cells(rng, 2))
.FormulaR1C1 = "=(R[0]C[-1]-R7C[-1])*86400"
.NumberFormat = "General"
End With
.Calculate
End With
Range("C7").Select
ActiveWindow.FreezePanes = True
'Messdaten-Blatt ans Ende der Zieldatei kopieren
With WBziel
wksXLS.Copy After:=.Sheets(.Sheets.Count)
strSheet = "'" & .Sheets(.Sheets.Count).Name & "'" 'Name in Formel
Set wksZiel = .Sheets(1)
End With
'Formeln im 1. Blatt ab Zeile 3 nach rechts einfügen
With wksZiel
'Zeile mit Protokoll/Datum
Zei_Z = 3
'nächste freie Spalte in der Zeile
Spa_Z = .Cells(Zei_Z, .Columns.Count).End(xlToLeft).Column + 1
'Spalten A und B werden nicht belegt
If Spa_Z 


Ich habe schon versucht es hinzubekommen aber habe es nicht zum laufen bekommen. Normalerweise müsste es doch möglich sein direkt nach dem Einfügen der Daten in die Zellen einen Rahmen vertikel rechts davon zu machen oder? Dann wären die Messwerte noch schön separiert. Wenn es nicht geht auch egal!
Vielen Dank
LG Tim
Anzeige
AW: Auswertung gleicher Tabellen in einer Excel
25.10.2016 19:03:18
fcs
Hallo Tim,
mit formatieren der Zellen in der rechten Spalte schaut der entsprechende Abschnitt des Makros wie folgt aus.
        'Zellen mit Zahlenwerte ab Zeile 5 formatieren
With .Range(.Cells(5, Spa_Z), .Cells(Zei_Z, Spa_Z + 1))
.NumberFormat = "#,##0.00;-#,##0.00;0.00"
.EntireColumn.AutoFit
End With
'Zellen in rechter Spalte ab Zeile 3 mit Rahmen rechts formatieren
With .Range(.Cells(3, Spa_Z + 1), .Cells(Zei_Z, Spa_Z + 1))
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.Color = RGB(Red:=0, green:=0, Blue:=0) 'schwarz
End With
End With
LG
Franz
Anzeige
AW: Auswertung gleicher Tabellen in einer Excel
27.10.2016 18:15:32
Tim
Vielen Dank Franz für deinen Support
LG Tim
AW: offen stellen vergessen oWt
22.10.2016 01:50:08
Piet
,,,

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige