Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
960to964
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
960to964
960to964
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro

Makro
14.03.2008 19:04:00
heiko
Hallo,
will ein Makro schreiben, mir fehlt aber der Ansatz.
Folgendes Problem:
1. Spalte Messwerte 70mm - 110mm
2.Spalte zugehörige Temperaturwerte
nun will ich aus der zweiten spalte den mittelwert der werte bilden, bei denen die erste spalte in einem bestimmten bereich liegt.also ein mittelwert aller Temperaturwerte zwischen 70 und 71 mm
dann ziwchen 71,1 und 72mm usw
jemand ne idee?

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro
14.03.2008 21:00:38
Peter
Hallo Heiko,
versuche es einmal so:


Option Explicit
Type Temperatur
   dAbstufung   As Double
   dTemperatur  As Double
   iAnzahl      As Integer
End Type
Public Sub Mittelwerte()
Dim TempTab()  As Temperatur
Dim iIndex     As Integer
Dim iStufe     As Integer
Dim lZeile     As Long
   For iIndex = 60 To 150 Step 10
      iStufe = iStufe + 1
      ReDim Preserve TempTab(iStufe)
      TempTab(iStufe).dAbstufung = iIndex
   Next iIndex
   For lZeile = 1 To Cells(Rows.Count, 1).End(xlUp).Row
      For iIndex = 1 To UBound(TempTab)
         If CDbl(Cells(lZeile, 1).Value) >= TempTab(iIndex).dAbstufung And _
            CDbl(Cells(lZeile, 1).Value) < TempTab(iIndex + 1).dAbstufung Then
            TempTab(iIndex).dTemperatur = TempTab(iIndex).dTemperatur + _
               CDbl(Cells(lZeile, 2).Value)
            TempTab(iIndex).iAnzahl = TempTab(iIndex).iAnzahl + 1
            Exit For
         End If
      Next iIndex
   Next lZeile
   lZeile = 0
   For iIndex = 1 To UBound(TempTab)
      If TempTab(iIndex).iAnzahl > 0 Then
         lZeile = lZeile + 1
         Cells(lZeile, 4).Value = TempTab(iIndex).dAbstufung
         Cells(lZeile, 5).Value = TempTab(iIndex).dTemperatur / TempTab(iIndex).iAnzahl
      End If
   Next iIndex
End Sub 


Gruß Peter

Anzeige
AW: Makro
14.03.2008 23:07:00
Daniel
HI
da du zufälligerweise die Berechnung in mm-Schritten staffeln willst, kannst du ja die mm als Index in einem Array verwenden. Dadurch lässt sich ein sehr einfacher Berechnungsalgoryhtmus schreiben:

Sub Durchschnitt()
Dim Anzahl(70 To 110) As Long
Dim SummeTemp(70 To 110) As Single
Dim D_Temp(70 To 110, 1 To 2)
Dim Daten
Dim i As Long
Dim Index As Long
Daten = Range("A1").CurrentRegion.Value
'--- Daten aufsummieren
For i = 2 To UBound(Daten, 1)
Index = WorksheetFunction.RoundUp(Daten(i, 1), 0)
Anzahl(Index) = Anzahl(Index) + 1
SummeTemp(Index) = SummeTemp(Index) + Daten(i, 2)
Next
'--- Durchschnitt errechen
For i = 70 To 110
D_Temp(i, 1) = i
Select Case Anzahl(i)
Case 0
D_Temp(i, 2) = "- - -"
Case Else
D_Temp(i, 2) = SummeTemp(i) / Anzahl(i)
D_Temp(i, 2) = WorksheetFunction.Round(D_Temp(i, 2), 1)
End Select
Next
'--- Daten zurückschreiben
Range("D2").Resize(UBound(D_Temp, 1) - LBound(D_Temp, 1) + 1, UBound(D_Temp, 2)) = D_Temp
End Sub


Das ist zwar sehrs speziell auf dein Beispiel zugeschnitten, aber dafür ne sehr schnelle berechnung:
https://www.herber.de/bbs/user/50750.xls
Gruß, Daniel

Anzeige
AW: Makro
14.03.2008 21:02:00
Gerd
Hi Heiko!

Sub ansatz()
Dim x, y, za, zb
x = Application.WorksheetFunction.SumIf(Range("A1:A7"), ">=70.1", Range("b1:b7"))
y = Application.WorksheetFunction.SumIf(Range("A1:A7"), ">71.0", Range("b1:b7"))
za = Application.WorksheetFunction.CountIf(Range("A1:A7"), ">=70.1")
zb = Application.WorksheetFunction.CountIf(Range("A1:A7"), ">=71.0")
End Sub


Und dann gibt es noch diverse Formeln, ist aber nicht so mein Ding.
Gruß Gerd

AW: Makro
14.03.2008 21:05:52
Peter
Hallo Heiko,
nachdem ich eben deine Frage noch einmal gelesen habe, ergibt sich folgende Korrektur:
For iIndex = 65 To 120
iStufe = iStufe + 1
ReDim Preserve TempTab(iStufe)
TempTab(iStufe).dAbstufung = iIndex
Next iIndex
Ein paar weitere Temperatur-Abstufungen zur Sicherheit wurden eingefügt.
Gruß Peter

Anzeige
AW: Makro
14.03.2008 23:17:00
heiko
naja habs mal so probiert, funktioniert erstmal, aber vielleicht bissl umständlich:

Sub neu()
Dim X, Z, Zähler, k, i, l, Summe
X = 1
Z = 0
Zähler = 0
Summe = 0
k = 71
For i = 1 To 55000
Range("B" & i).Select
If Selection = k - 1 Then
Z = Z + 1
Zähler = Zähler + 1
Range("C" & i).Select
Selection.Copy
Range("D" & Z).Select
ActiveSheet.Paste
ElseIf Selection > k Then
Range("E" & X).Select
Selection = k
For l = 1 To Z
Range("D" & l).Select
Summe = Summe + Selection
Next l
Range("F" & X).Select
Selection = Summe / Z
Summe = 0
Z = 0
X = X + 1
k = k + 1
Columns("D:D").Select
Selection.ClearContents
End If
If k = 110 Then
End
Else
End If
Next i
End Sub


Anzeige
AW: Makro
15.03.2008 12:46:05
Peter
Hallo Heiko,
wenn du die Aufteilung in der Form 70,1 - 71,0; 71,1 - 72,0 usw haben möchtest, dann musst du lediglich die Abfrage etwas umstellen:
https://www.herber.de/bbs/user/50754.xls
Gruß Peter

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige