Hallo Holger,
vielen Dank, dass Du mir wieder hilfst.
Mein Hauptproblem ist das Erzeugen und Beschreiben der neuen Tabellenblätter. In der Ersten For-Next-Schleife schaust Du nach ob schon neue Tabellenblätter existieren und löschst diese, das habe ich verstanden. Müsste danach nicht wieder eine Schleife kommen, die zu jedem Tabellenblatt ein neues hinzufügt?
Mit:
Sheets.Add
ActiveSheet.Name = "AW_" + TabName
Sheets(TabName).Activate
wird doch nur eine Tabelle vor dem ersten Tabellenblatt erzeugt. Ich möchte aber für jedes existierende Tabellenblatt eine neue (Auswert-)Tabelle erzeugen, diese dahinter anordnen und mit den dazugehörigen Max-Min-Werten und den Nullstellen füllen.
Die Tabellenköpfe sollen mit in die neue Tabelle übernommen werden und in der zweiten Zeile stehen.
Die Zelladressierung ist so gemeint, dass die Spalten in der Ursprungstabellen fortlaufend belegt sind und von Spalte 2 an untersucht werden sollen. In der neuen Tabelle wird zunächst dazwischen immer eine Spalte frei gelassen, da in diese dann aus der ersten Spalte (der Ursprungstabelle) der Zeitpunkt des Auftretens eines Maximums, Minimums bzw. einer Nullstelle übernommen werden soll (und zwar für jede Spalte extra).
Ich hoffe ich falle Dir mit meinen „Sorgen“ nicht allzu sehr zur Last und würde mich freuen, wieder von Dir zu hören.
Liebe Grüße
Sabine
Holger schrieb am 27.06.2009 11:41:14:
Hallo Sabine,
ich würde die neue Tabelle sofort bei der Min-Max-Nullstellen-Prüfung erzeugen. Ob ich die Adressen auf der neuen Tabelle richtig verstanden habe, weiß ich nicht. Ich lasse die Daten bei A3 unabhängig von deiner Bemerkung zu den Tabellenköpfen beginnen und übernehme die Formatierung. Du kannst es aber leicht ändern.
Sub max_min()
Zeile1 = 8
Spalte1 = 2
farbemax = 3
farbemin = 5
TabName = ActiveSheet.Name
For Each WS In Worksheets
If WS.Name = "AW_" + TabName Then WS.Delete
Next
Sheets.Add
ActiveSheet.Name = "AW_" + TabName
Sheets(TabName).Activate
nz = 3
Cells.Interior.ColorIndex = xlNone
For j = Spalte1 To Cells(8, Columns.Count).End(xlToLeft).Column
nz = 3
s = Sgn(Cells(Zeile1 + 1, j) - Cells(Zeile1, j))
If s = 0 Then
For i = Zeile1 To Cells(Rows.Count, j).End(xlUp).Row - 1
t = Sgn(Cells(i + 1, j) - Cells(i, j))
If t kleinergrößer 0 Then Exit For
Next i
If i kleiner Cells(Rows.Count, j).End(xlUp).Row - 1 Then
If t = -1 Then
Cells(Zeile1, j).Interior.ColorIndex = farbemax
Sheets("AW_" + TabName).Cells(nz, j - 1) = Cells(Zeile1, j)
Sheets("AW_" + TabName).Cells(nz, j - 1).Interior.ColorIndex = farbemax
nz = nz + 1
Else
Cells(Zeile1, j).Interior.ColorIndex = farbemin
Sheets("AW_" + TabName).Cells(nz, j - 1) = Cells(Zeile1, j)
Sheets("AW_" + TabName).Cells(nz, j - 1).Interior.ColorIndex = farbemin
nz = nz + 1
End If
End If
End If
For i = Zeile1 To Cells(Rows.Count, j).End(xlUp).Row - 1
If (Sgn(Cells(i + 1, j)) kleinergrößer Sgn(Cells(i, j))) Or Cells(i, j) = 0 Then 'Nullstellen
Cells(i, j).Font.Bold = True
Sheets("AW_" + TabName).Cells(nz, j - 1) = Cells(i, j)
Sheets("AW_" + TabName).Cells(nz, j - 1).Font.Bold = True
nz = nz + 1
End If
Select Case Cells(i + 1, j) - Cells(i, j)
Case Is kleiner 0
If s kleinergrößer -1 Then
s = -1
Cells(i, j).Interior.ColorIndex = farbemax
Sheets("AW_" + TabName).Cells(nz, j - 1) = Cells(i, j)
Sheets("AW_" + TabName).Cells(nz, j - 1).Interior.ColorIndex = farbemax
nz = nz + 1
End If
Case Is größer 0
If s kleinergrößer 1 Then
s = 1
Cells(i, j).Interior.ColorIndex = farbemin
Sheets("AW_" + TabName).Cells(nz, j - 1) = Cells(i, j)
Sheets("AW_" + TabName).Cells(nz, j - 1).Interior.ColorIndex = farbemin
nz = nz + 1
End If
Case Else
If i größer Zeile1 Then
Cells(i, j).Interior.ColorIndex = Cells(i - 1, j).Interior.ColorIndex
Sheets("AW_" + TabName).Cells(nz, j - 1) = Cells(i, j)
Sheets("AW_" + TabName).Cells(nz, j - 1).Interior.ColorIndex = farbemax
nz = nz + 1
End If
End Select
Next i
Next j
End Sub
Gruß
Holger
Sabine schrieb am 26.06.2009 18:35:52:
Hallo,
auf meine letzte Anfrage(Beitrag: Nullstellen, Maxima und Minima markieren), wurde mir von Holger wunderbar geholfen. Nun möchte ich die so erzeugten Tabellen weiterbearbeiten. Meine Testversion funktioniert, ist aber wahrscheinlich etwas umständlich und auch nicht vollständig:
Sub Formatierte_Werte_übertragen()
Zeile1 = 8
Spalte1 = 2
Zeile2 = 3
Spalte2 = 8
farbemax = 3 'rot
farbemin = 33 'hellblau
For j = Spalte1 To Cells(Zeile1,Columns.Count).End(xlToLeft).Column
For i = Zeile1 To Cells(Rows.Count, Spalte1).End(xlUp).Row
If Cells(i, Spalte1).Font.Bold = True Then
Cells(Zeile2, Spalte2) = Cells(i, Spalte1)
Cells(Zeile2, Spalte2).Font.Bold = True
Cells(Zeile2, Spalte2 - 1) = Cells(i, 1)
Zeile2 = Zeile2 + 1
ElseIf Cells(i, Spalte1).Font.ColorIndex = farbemax Then
Cells(Zeile2, Spalte2) = Cells(i, Spalte1)
Cells(Zeile2, Spalte2).Font.ColorIndex = farbemax
Cells(Zeile2, Spalte2 - 1) = Cells(i, 1)
Zeile2 = Zeile2 + 1
ElseIf Cells(i, Spalte1).Font.ColorIndex = farbemin Then
Cells(Zeile2, Spalte2) = Cells(i, Spalte1)
Cells(Zeile2, Spalte2).Font.ColorIndex = farbemin
Cells(Zeile2, Spalte2 - 1) = Cells(i, 1)
Zeile2 = Zeile2 + 1
End If
Next i
Spalte1 = Spalte1 + 1
Zeile2 = 3
Spalte2 = Spalte2 + 2
Next j
End Sub
Nun möchte ich die so herausgefilterten Daten nicht, wie hier geschehen, in eine der hinteren Spalten schreiben, sondern in ein neues Tabellenblatt, das hinter das Tabellenblatt mit den Daten angehängt wird. Das neue Tabellenblatt soll mit „AW & `dem Namen der Ursprungstabelle‘“ benannt sein. Es soll darin mit Spalte A und Zeile 3 begonnen werden. In Zeile 2 werden die Tabellenköpfe übernommen allerdings immer in die übernächste Spalte, da jeder Datenspalte der Zeitpunkt aus Spalte A vorgesetzt wird.
Es gibt eine variierende Anzahl von Daten-Tabellenblättern je Arbeitsmappe mit 7 bis 8 Spalten und unbegrenzt viele Zeilen je Tabellenblatt. Die Formatierung soll beibehalten werden.
Vielleicht kann mir jemand helfen.
Vielen Dank
Sabine
|