Sub Kleinster_Wert_Markiere_Zelle()
'1. Finde gesuchte Eigenschaft und markiere nur die sichtbaren Werte (getroffene Auswahl)
'2. Definiere Variablen
'3. Setze getroffene Auswahl ein für Schritt 4.
'4. Zellen mit Datum oder Prozente werden in Werte überführt
'1. Finde gesuchte Eigenschaft und markiere nur die sichtbaren Werte (getroffene Auswahl)
ActiveSheet.ListObjects("Table1").ListColumns("Eigenschaft 1").DataBodyRange.SpecialCells(xlCellTypeVisible).Select
'2. Definiere Variable
Dim strData As String
Dim rng As Range
Dim vValue As Variant
Dim rngCol As Range
Dim lngRow As Long
Dim rngAdd As Range
'3. Setze getroffene Auswahl ein für Schritt 4.
strData = Selection.Address
Set rng = Range(strData)
'Bestimme kleinsten Wert in der Auswahl
vValue = Application.WorksheetFunction.Min(rng)
For Each rngCol In rng.Columns
'Determines in case the smallest value exists in a particular column
If Application.WorksheetFunction.CountIf(rngCol, vValue) > 0 Then
'Returns row number of the smallest value, in the column which has the same
lngRow = Application.WorksheetFunction.Match(vValue, rngCol, 0)
'Returns cell address of the smallest value
Set rngAdd = rngCol.Cells(lngRow, 1)
'Selects smallest value to highlight with color
rngAdd.Select
End If
Next
With Selection
.Interior.Color = vbGreen
End With
End Sub
|