Excel: Standardabw. für Matrix B:C jeweils getrennt für Werte in A

[Smarty]

Hallo zusammen,

ich habe aktuell ein Problem, vor dem ich immer wieder stehe in Excel.
Sagen wir, ich hole mir von jeweils 10-20 Anbietern Angebote für 5 verschiedene Produkte ein, und zwar jeweils in den Farben blau und schwarz.
In Spalte A steht dann Produkt1, Produkt1, Produkt1,... Produkt2, Produkt2,... Produkt5.
In Spalte B die Preise für das blaue Produkt, in C für schwarz. (In D steht z.B. der Anbieter, aber das ist erst mal nebensächlich.)
Erhöhte Schwierigkeit: Nicht jeder Anbieter führt jedes Produkt in beiden Farben.

Ich will jetzt in einer neuen Matrix für jedes Produkt den mittleren Preis und die Standardabweichung, und zwar unabhängig von der Farbe. Gäbe es nur eine Farbe, wäre das überhaupt kein Problem: Daten/Teilergebnis/Mittelwert bzw. /Standardabweichung. Der Mittelwert geht aufgrund der wahren Datenbeschaffenheit auch trotzdem noch: Teilergebnis getrennt für die Spalten und dann darüber nochmal mitteln. Bei der Standardabweichung kommt da aber natürlich völliger Murks raus.

Weiß jemand eine Lösung? Darf gerne auch VBA beinhalten, aber das beherrsche ich leider goar nischt.

 

[Smarty]

Soo, habe eine Lösung, die ich noch teilen möchte.
Es wird davon ausgegangen, dass die Datei anfangs nur ein Worksheet hat; da stehen in Spalte 4 die Produktcodes. Die Ergebnisse werden in das Tabellenblatt Ergebnisse" geschrieben.

Sub Makro1()
' Screenupdating aus um es zu beschleunigen
Application.ScreenUpdating = False
' Das beim Start aktive Sheet benennen, damit man es hinterher gut aufrufen kann
sht = ActiveSheet.Name
' Kopiere die (noch mit lauter Doppelten versehenen) Produktcodes ins neu erstellte Sheet Ergebnisse
Worksheets(sht).Columns("D:D").Copy
Worksheets.Add().Name = "Ergebnisse"
Worksheets("Ergebnisse").Range("A:A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     :=False, Transpose:=False
Application.CutCopyMode = False

' Entferne die Duplikate in den Produktcodes
Worksheets("Ergebnisse").Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes

' Jetzt gehts mit der Standardabweichungsberechnung los
' In Zeile 1 stehen die Überschriften, also ab Zeile 2 loslegen
' solange das nicht leer ist: Bis zum Ende der unique Produktcodes
iRow = 2
' In einer Schleife Zeile für Zeile vorgehen
' In Spalte 1 stehen die uniqe Produktcodes ab Zeile 2
Do While Not IsEmpty(Cells(iRow, 1))
    ' Nimm den Wert in Ergebnisse!A2 im ersten Durchlauf
    veranst = Worksheets("Ergebnisse").Cells(iRow, 1)
    ' Setze im Daten-Sheet einen Datenfilter in Spalte D (Product-Code) auf das, was im Ergebnis-Sheet gerade ausgewählt ist.
    Worksheets(sht).Range("A:BA").AutoFilter Field:=4, Criteria1:=veranst
    ' Berechne die Standardabweichung der jetzt sichtbaren Zellen (Subtotal 7) in den Spalten AD bis AF (verschiedene Preise)
    Worksheets("Ergebnisse").Cells(iRow, 2) = WorksheetFunction.Subtotal(7, Worksheets(sht).Range("AD:AF"))
    ' Gehe zur nächsten Zeile in den unique Produktcodes
    iRow = iRow + 1
Loop

' Hebe den Filter auf
ActiveWorkbook.Worksheets(sht).AutoFilter.Sort.SortFields.Clear
Worksheets(sht).ShowAllData
Application.ScreenUpdating = True
End Sub

Laufzeit ist schon ganz erträglich, aber wenn jemand Verbesserungen hat: Immer her damit!

 

[Smarty]

Arg, habe doch noch ne Frage dazu:
Die While-Schleife macht noch einen letzten Durchlauf mit der ersten Zeile, die eigentlich nicht mehr in der Liste ist und bricht erst danach ab. Das macht bei den Standardabweichungen nichts, aber sobald ich in der Schleife auch Mittelwerte berechnen lassen will, bricht er mit einem Fehler ab. Wie beende ich das vorher?

Edit: Durch eine For iRow = 3 to Worksheets("Ergebnisse").UsedRange.Rows.Count Schleife ersetzt
Außerdem einen If-Block eingefügt, der keine Werte berechnet, falls die Anzahl der Angebote = 1 ist (dann gibt's nämlich keine Standardabweichung). Bin jetzt soweit ganz glücklich mit dem Skript :-)