Kleinster Wert mit Bedingung - große Range

Sub minmax() With ThisWorkbook.Worksheets("Produkte") minA = 10000 minB = 10000 minC = 10000 For icol = 2 To .UsedRange.Columns.Count 'zb. Länder For irow = 7 To .UsedRange.Rows.Count ' zb. Preise Select Case .Cells(irow, 1) ' Produkte Case Is = "A" If .Cells(irow, icol) maxA Then maxA = .Cells(irow, icol) Case Is = "B" If .Cells(irow, icol) maxB Then maxB = .Cells(irow, icol) Case Is = "C" If .Cells(irow, icol) maxC Then maxC = .Cells(irow, icol) End Select Next irow .Cells(1, icol) = minA .Cells(2, icol) = maxA .Cells(3, icol) = minB .Cells(4, icol) = maxB .Cells(5, icol) = minC .Cells(6, icol) = maxC minA = 10000 maxA = 0 minB = 10000 maxB = 0 minC = 10000 maxC = 0 Next icol End With End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hi
bei großen Datenmengen könnte es sinnvoll sein, die Tabelle zu sortieren, so dass die gleichen Produkte direkt untereinander stehen.
dann kannst du den entsprechenden Zellbereich für dieses Produkt ermitteln und die einfachen MIN- und MAX-Funktionen verwenden.
Im Sortieren ist Excel sehr schnell.

Sub MinMax()
Dim Zelle1 As Range
Dim Zelle2 As Range
Dim minA, maxA, minB, maxB, minC, maxC
With ThisWorkbook.Worksheets("Produkte")
With .Range(.Cells(7, 1), Cells.SpecialCells(xlCellTypeLastCell))
.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlGuess
Set Zelle1 = .Columns(1).Find(what:="A", lookat:=xlWhole, searchdirection:=xlNext)
Set Zelle2 = .Columns(1).Find(what:="A", lookat:=xlWhole, searchdirection:=xlPrevious)
With Range(Zelle1, Zelle2).Resize(, .Columns.Count)
minA = WorksheetFunction.Min(.Cells)
maxA = WorksheetFunction.Max(.Cells)
End With
Set Zelle1 = .Columns(1).Find(what:="B", lookat:=xlWhole, searchdirection:=xlNext)
Set Zelle2 = .Columns(1).Find(what:="B", lookat:=xlWhole, searchdirection:=xlPrevious)
With Range(Zelle1, Zelle2).Resize(, .Columns.Count)
minB = WorksheetFunction.Min(.Cells)
maxB = WorksheetFunction.Max(.Cells)
End With
Set Zelle1 = .Columns(1).Find(what:="C", lookat:=xlWhole, searchdirection:=xlNext)
Set Zelle2 = .Columns(1).Find(what:="C", lookat:=xlWhole, searchdirection:=xlPrevious)
With Range(Zelle1, Zelle2).Resize(, .Columns.Count)
minC = WorksheetFunction.Min(.Cells)
maxC = WorksheetFunction.Max(.Cells)
End With
End With
End With
End Sub

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

Kleinster Wert mit Bedingung - große Range

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kleinster Wert mit Bedingung - große Range

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread