Werte aus Zeile kopieren wenn bestimmter Text in Spalte A

Hallo zusammen,

zur Auswertung erhalte ich täglich Excel-Tabellen mit Daten aus unserem Produktionsbetrieb. Hierbei wird für verschiedene Anlagenteile je ein Tabellenblock erstellt, in dem im 5 Minuten Takt ein Datensatz erstellt und aufgelistet wird. Am Ende dieses Blocks werden die Daten im Gesamten ausgewertet und angezeigt. Diese Gesamtauswertungen würde ich gerne auf einen Blick sehen können, da ich immer alle 2500 bis 3000 Zeilen durchscrollen muss, um diese zu sehen. In der Beispieldatei (164373.xlsx) wird ersichtlich worum es geht. Der darin rot umrandete Teil soll erzeugt werden. Das Problem dabei ist, dass die Anzahl der Zeilen für jeden Block immer variiert (Heute steht die Gesamtauswertung von Anlagenteil 1 in Zeile 61, morgen in Zeile 57 usw). Auch die Anzahl der Zeilen der Blöcke untereinander unterscheidet sich täglich (Heute ist der Block zu Anlagenteil 1 größer als der zu Anlagenteil 2, morgen umgekehrt...).
Es müsste also immer das Symbol "Σ" in Spalte A erkannt werden, dann die Werte aus den Spalten D, E und F dieser Zeile (Block-Anlagenteil 1), in die Zellen H6, I6 und J6 kopiert und der Text aus der zusammengefügten Spalte über der ersten "Σ-Spalte" (Anlagenteil 1) nach G6 kopiert werden.
Das ganze dann mit der nächsten Zeile, bei der in Spalte A das "Σ" enthalten ist (Block-Anlagenteil 2), wobei das dann nach G7, H7, I7,und J7 kopiert werden soll. und das dann immer so weiter, so dass eine Auflistung aller Gesamtauswertungen entsteht.
Die Bezeichnungen im Beispiel habe ich aus datenschutzrechtlichen Gründen verändert.
Einen solchen VBA-Code zu erstellen übersteigt meine Kenntnisse dafür. Ich hoffe das es überhaupt möglich ist.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Summenzeile() Dim lrow&, i&, cnt& Dim suchzeichen&: suchzeichen = 83 ' ASC(Summenzeichen) ist 83 With Worksheets("Tabelle1") 'name anpassen lrow = .Cells(Rows.Count, 1).End(xlUp).Row cnt = .Cells(Rows.Count, "H").End(xlUp).Row 'Ergebnisbereich leeren Range(.Cells(6, "H"), .Cells(cnt, "K")).ClearContents For i = 6 To lrow If .Cells(i, 1) > "" Then If Asc(.Cells(i, 1)) = suchzeichen Then If .Cells(i, 1).Offset(-1).MergeCells Then cnt = cnt + 1 .Cells(cnt, "H") = .Cells(i, 1).Offset(-1).MergeArea.Cells(1) .Cells(cnt, "H").Offset(0, 1).Resize(1, 3).Value = .Cells(i, 1).Offset(0, 3).Resize(1, 3).Value End If End If End If Next End With End Sub

Sub test() Dim x As Range Dim Zeile As Long Zeile = 6 For Each x In Columns(2).SpecialCells(xlCellTypeConstants, 1).Areas Cells(Zeile, 7) = x.Cells(1, 1).Offset(0, -1).Value Cells(Zeile, 8).Resize(1, 3).Value = x(1).Offset(x.Rows.Count, 2).Resize(1, 3).Value Zeile = Zeile + 1 Next End Sub

Beliebteste Forumthreads (12 Monate)

Werte aus Zeile kopieren wenn bestimmter Text in Spalte A

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread