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
|