Daten auswerten
07.09.2005 03:55:07
Heinz
ich habe folgendes Problem:
In einer Tabelle werden jeden Tag Daten eingegeben.
In Spalte F wird einen Nummer eingegeben. Diese kann aus reinen Zahlen
aber auch aus Zahlen getrennt durch einen Schräg- oder Bindestrich sein.
In Spalte L wird einen Zeit in Minuten eingetragen.
Nun kommen die Zahlen in Spalte F mehrmals vor.
Ich habe eine Auswertung über Makro die dieses mehrfach vorkommenden Daten
erfasst und die Minuten zusammenrechnet und auf einem anderen Tabellenblatt ausgibt.
Wenn ich nun diese Minuten einfach zusammenrechne kann ich damit nicht viel anfangen.
Ich bräuchte eine Möglichkeit ein Mittel zu bilden.
Also wenn ich die Nummer 123 habe und diese 5 mal vorkommt, dabei 5, 10, 15, 20, 10 als Minuten habe darf nicht die Summe ( 60 ) rauskommen sondern das Mittel ( 15 ). Ich hoffe ich konnte es ausreichend erklären.
Das Makro wird jeweils aus dem Monatschart gestartet.
Anbei mal das Makro:
Type MeineDaten
SerienNummer As Variant 'aus Spalte F
Zeit As Long 'aus Spalte L
Dat As Date
End Type
Dim MDaten(230) As MeineDaten, tmpMDaten As MeineDaten
Public
Sub Zählen()
Application.ScreenUpdating = False
Dat = Range("b1")
Worksheets("Sammeldaten").Unprotect Password:="xxxx"
Worksheets("Sammeldaten").Range("A2:o40") = ""
AnfangsZeile = 5
AnzahlSerienNummer = 0
For i = AnfangsZeile To AnfangsZeile + 315
tmpSerienNummer = Cells(i, 6)
If tmpSerienNummer <> "" Then
Gefunden = False
For k = 1 To AnzahlSerienNummer
If tmpSerienNummer = MDaten(k).SerienNummer Then
MDaten(k).Zeit = MDaten(k).Zeit + Cells(i, 12)
Gefunden = True
Exit For
End If
Next k
If Not Gefunden Then
AnzahlSerienNummer = AnzahlSerienNummer + 1
MDaten(AnzahlSerienNummer).SerienNummer = tmpSerienNummer
MDaten(AnzahlSerienNummer).Zeit = Cells(i, 12)
End If
End If
Next i
'Sortieren nach Spalte b
Do
keine_umstell = True
For i = 1 To AnzahlSerienNummer - 1
tmpMDaten = MDaten(i)
If tmpMDaten.Zeit < MDaten(i + 1).Zeit Then
MDaten(i) = MDaten(i + 1)
MDaten(i + 1) = tmpMDaten
keine_umstell = False
End If
Next i
Loop Until keine_umstell = True
'Ausgabe für Spalte b
For i = 1 To AnzahlSerienNummer
Worksheets("Sammeldaten").Cells(2 + i, 1) = MDaten(i).SerienNummer
Worksheets("Sammeldaten").Cells(2 + i, 2) = MDaten(i).Zeit
Next i
Worksheets("Sammeldaten").Cells(2, 1) = Dat
Worksheets("Sammeldaten").Protect Password:="xxxx"
Application.ScreenUpdating = True
End Sub
Danke vor ab.
Gruß
Heinz
Anzeige