sortieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: sortieren

25.09.2007 15:01:10

Peter

AW: sortieren

25.09.2007 15:04:22

Ralf

AW: sortieren

25.09.2007 15:39:00

Peter

AW: sortieren

25.09.2007 15:57:00

Peter

Hallo Ralf,
dann so:

Sub MaxWert()
Dim lUnZei     As Long     ' die letzte belegte Zeile  "Messdaten" in Spalte A
Dim iLiSpa     As Integer  ' die letzte belegte Spalte "Messdaten" in Zeile !
Dim iSpalte    As Integer  ' For/Next Spalten-Index
Dim Bereich    As Range    ' der zu sortierende Bereich
Dim lZeile     As Long     ' die zu füllende Zeile im Blatt "Ergebnis"
   lZeile = 2
   Worksheets("Messung").Activate
   With Worksheets("Messung")
      lUnZei = IIf(.Range("A65536") <> "", 65536, .Range("A65536").End(xlUp).Row)
      iLiSpa = IIf(.Cells(1, 256) <> "", 256, .Cells(1, 256).End(xlToLeft).Column)
      Set Bereich = .Range(.Cells(2, 1), .Cells(lUnZei, iLiSpa))
      For iSpalte = 2 To iLiSpa
         Bereich.Sort _
            Key1:=Cells(2, iSpalte), Order1:=xlDescending, _
            Key2:=Cells(2, 1), Order2:=xlDescending, _
            Header:=xlNo, OrderCustom:=1, _
            MatchCase:=False, Orientation:=xlTopToBottom
         Worksheets("Ergebnis").Range("A" & lZeile).Value = _
            Format(Left(.Range("A2").Value, 10), "dd.mm.yyyy")
         Worksheets("Ergebnis").Range("B" & lZeile).Value = _
            Mid(.Cells(1, iSpalte).Value, 5)
         Worksheets("Ergebnis").Range("C" & lZeile).Value = .Cells(2, iSpalte).Value
         lZeile = lZeile + 1
      Next iSpalte
   End With
End Sub

Gruß Peter

Hallo Ralf,
hier noch einmal das Makro mit Dokumentation.

Option Explicit
'
'   Ich möchte aus einer Tabelle, in der Messwerte aus einer Maschine abgespeichert
'   sind, die Höchstwerte automatisch heraussortieren und in eine neue Tabelle schreiben.
'
'   In der Tabelle mit den Messwerten, wird für jeden Messpunkt, jede Minute ein Wert
'   abgelegt.
'   In der zu erstellenden Tabelle soll dann halt nur noch der Maximalwert, mit
'   Datumsangabe enthalten sein.
'   Wobei bei gilt, wenn der Maximalwert mehrfach vorkommt, dann wird der geschrieben,
'   der am neuesten ist.
'
'   Wichtig ist noch, dass die Messpunkte immer andere Namen haben und bis zu 200 Stück
'   nebeneinander stehen.
'
'   Lösung:
'
'   Es werden die Spalten einzeln von links nach rechts absteigend sortiert, wobei
'   die jeweilige Spalte der Key1, das Datum (Spalte A) der Key2 ist.
'
Sub MaxWert()
Dim lUnZei     As Long     ' die letzte belegte Zeile  "Messdaten" in Spalte A
Dim iReSpa     As Integer  ' die letzte belegte Spalte "Messdaten" in Zeile 1
Dim iSpalte    As Integer  ' For/Next Spalten-Index
Dim Bereich    As Range    ' der zu sortierende Bereich
Dim lZeile     As Long     ' die zu füllende Zeile im Blatt "Ergebnis"
   lZeile = 2              ' Start-Zeile im Blatt "Ergebnis"
   Worksheets("Messung").Activate ' das Blatt "Messung" zum Sort aktivieren
   With Worksheets("Messung")
      lUnZei = IIf(.Range("A65536") <> "", 65536, .Range("A65536").End(xlUp).Row)
      iReSpa = IIf(.Cells(1, 256) <> "", 256, .Cells(1, 256).End(xlToLeft).Column)
      Set Bereich = .Range(.Cells(2, 1), .Cells(lUnZei, iReSpa)) ' der Datenbereich
      For iSpalte = 2 To iReSpa ' es werden die Spalten B bis Ende einzeln sortiert
         Bereich.Sort _
            Key1:=Cells(2, iSpalte), Order1:=xlDescending, _
            Key2:=Cells(2, 1), Order2:=xlDescending, _
            Header:=xlNo, OrderCustom:=1, _
            MatchCase:=False, Orientation:=xlTopToBottom
         Worksheets("Ergebnis").Range("A" & lZeile).Value = _
            Format(Left(.Range("A2").Value, 10), "dd.mm.yyyy")  ' Datum
         Worksheets("Ergebnis").Range("B" & lZeile).Value = _
            Mid(.Cells(1, iSpalte).Value, 5)                    ' Herkunft = Spaltenkopf
         Worksheets("Ergebnis").Range("C" & lZeile).Value = _
            .Cells(2, iSpalte).Value                            ' Max-Temperatur
         lZeile = lZeile + 1    ' Zeile in "Ergebnis" erhöhen
      Next iSpalte              ' die nächste Spalte zur Auswertung holen
   End With
End Sub

Gruß Peter

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread