Excel - Finden Sie den Maximalwert alle 10 Zeilen und markieren Sie die Zeile

Problem

Ich brauche Hilfe beim Erstellen einer Formel in Excel, um die höchsten und niedrigsten Werte alle 10 Zeilen zu identifizieren. DANN Identifizieren Sie diese beiden Zeilen, indem Sie Text oder eine Zahl in eine leere Spalte in den Zeilen mit den höchsten und niedrigsten Werten einfügen. Zum Beispiel möchte ich das Wort keep in Spalte A3 für NUR den höchsten und niedrigsten Handelspreis für jedes Inkrement von 10 Zeilen zurückgeben. Auf diese Weise kann ich die Daten nach Behalten sortieren und die anderen 8 Datenzeilen löschen. Auf diese Weise kann ich den größten Teil meiner Datenintegrität bewahren und die Größe der Datei erheblich reduzieren.

Ich verwende Excel 2007 und habe 160.000 Datenzeilen. Der Zweck der Formel ist es, diese Daten um 80% zu reduzieren

Die nachstehende Tabelle enthält ein einfaches Beispiel.

 Handelszeit Preis C ist eine leere Spalte für die Formelausgabe. ___________A____________B____________C Zeile 1 19:30:25 121.81 Zeile 2 19:30:26 121.80 Halten Sie Zeile 3 19:30:29 121.83 Zeile 4 19:30:31 121.86 Halten Sie Zeile 5 19 : 39: 35 121, 84 

Jede Hilfe wäre sehr dankbar.

Lösung

Es gibt 3 Makros "test", "test1" und "undo". Test1 ist in "test" eingebettet, es reicht also aus, wenn Sie nur das Makro "test" ausführen.

Alle drei Makros sollten sich im Modul befinden. Makro "Rückgängig" macht die Makroergebnisse rückgängig.

Nehmen Sie einen kleinen Auszug Ihrer Daten über 31 Zeilen und überprüfen Sie das Makro. Wenn die Ergebnisse in Ordnung sind, können Sie die Makros in Ihrer Originaldatei verwenden

BEWAHREN SIE DIE ORIGINALDATEI SICHER AUF, UM SIE ABRUFEN ZU KÖNNEN.

Makro 1:

 Dim r As Range, r1 As Range, x As Double, y As Double Dim j As Integer, k As Integer Dim r2 As Range, m As Integer Sub test () Arbeitsblätter ("sheet1") .Aktiviere Range ("c1") = "signal" Setze r2 = Range (Range ("B1"), Range ("B1"). End (xlDown)) j = 1 m = 1 Setze r = Cells (j * m + 1, "B") MsgBox r.Address Set r1 = Bereich (r, r.Offset (9, 0)) MsgBox r1.Address If r.Offset (9, 0) = "" Dann Beenden Do x = WorksheetFunction.Min (r1) y = WorksheetFunction .Max (r1) MsgBox x MsgBox yk = WorksheetFunction.Match (x, r2, 0) Zellen (k, "c") = "keep" k = WorksheetFunction.Match (y, r2, 0) Zellen (k, "c ") =" keep "m = m + 10 MsgBox m Schleifentest1 End Sub 

Makro 2:

 Untertest1 () Arbeitsblätter ("sheet1"). Set r = Range (Range ("A1"), Range ("A1"). End (xlDown) .Offset (0, 3)) r.AutoFilter-Feld: = 3, Criteria1: = "keep" r.Cells.SpecialCells (xlCellTypeVisible) .Copy Worksheets ("sheet2"). Range ("A2") ActiveSheet.AutoFilterMode = False End Sub 

Makro 3:

 Sub undo () Arbeitsblätter ("sheet1"). Range ("c1"). EntireColumn.Delete Arbeitsblätter ("sheet2"). Cells.Clear End Sub 

Hinweis

Danke an venkat1926 für diesen Tipp im Forum.