Kleinster Wert

[Topology]

Hallo,

Ich habe in Spalte 1 Werte zwischen 1 und XX
in Spalte 5 gehen Werte die vom + ins -....

und ich möchte, dass sich die Werte in Spalte 5 anpassen
Wenn in spalte 1 der selbe Wert (also 1,1 steht) dann soll der kleinere wert von spalte 5 in beiden Zellen in spalte 5 stehen.



wie geht das per vba?



Grüße,
XX

[Ego]

Hallo XX,

in der Anlage einmal ein Beispielmakro. Und hier einige Bemerkungen:

A. Da ich ungern feste Adressen in die Programme schreibe habe ich zwei benannte Bereiche eingerichtet.
1. Benannter Bereich "Liste" sind die Begriffe in Spalte A
2. Benannter Bereich "Kleinste" sind die zugehörigen Werte
Beide Bereiche müssen gleich lang sein.

B. Ich habe für die Verwaltung ein Dictionary genutzt.
Ab  einigen zig Einträgen ist es schneller als ein einfaches Array (und der code ist kürzer).
Ab ca. hunderttausend Einträgen ist in Excel eine Collection ein wenig schneller.

C. Dein Beispiel oder die Beschreibung ist falsch.
-0,2 ist eindeutig kleiner als -0,05

Code:

Option Explicit

Sub Machs()
Dim lngZeile As Long
Dim varKey As Variant
Dim varListe As Variant
Dim varKleinste As Variant
Dim dict As Object

Set dict = CreateObject("Scripting.Dictionary")
'-----------------------------
' in die Arrays übernehmen
'-----------------------------
varListe = ThisWorkbook.Names("Liste").RefersToRange.Value
varKleinste = ThisWorkbook.Names("Kleinste").RefersToRange.Value
'-----------------------------
' ins Dictionary einlesen
'-----------------------------
For lngZeile = 1 To UBound(varListe, 1)
    varKey = varListe(lngZeile, 1)
    If dict.exists(varKey) Then
        If varKleinste(lngZeile, 1) < dict(varKey) Then
            dict(varKey) = varKleinste(lngZeile, 1)
        End If
    Else
        dict(varKey) = varKleinste(lngZeile, 1)
    End If
Next lngZeile
'-----------------------------
' aus Dictionary schreiben
'-----------------------------
For lngZeile = 1 To UBound(varListe, 1)
    varKey = varListe(lngZeile, 1)
    varKleinste(lngZeile, 1) = dict(varKey)
Next lngZeile
'-----------------------------
' ins Blatt übergeben
'-----------------------------
ThisWorkbook.Names("Kleinste").RefersToRange.Value = varKleinste
End Sub

[Topology]

Hallo @Ego

Sorry mein Fehler ich meinte den kleinsten Wert zu 0 hin =)


ouu das ist ein komplizierter Code da muss ich mich mal einlesen =D 


danke,  klappt soweit bis auf den kleinste Differenz zu null..

ich geb bescheid sobald ich das durchgekaut habe, habe nämich noch nie was mit dictionarys gemacht


Grüße
und vielen Dank!!

[Topology]

Code:

Option Explicit

Sub Machs()
Dim lngZeile As Long
Dim varKey As Variant
Dim varListe As Variant
Dim varKleinste As Variant
Dim dict As Object

Set dict = CreateObject("Scripting.Dictionary")
'-----------------------------
' in die Arrays übernehmen
'-----------------------------
varListe = ThisWorkbook.Names("Liste").RefersToRange.Value
varKleinste = ThisWorkbook.Names("Kleinste").RefersToRange.Value
'-----------------------------
' ins Dictionary einlesen
'-----------------------------
For lngZeile = 1 To UBound(varListe, 1)
    varKey = varListe(lngZeile, 1)
    If dict.exists(varKey) Then
        If varKleinste(lngZeile, 1) < dict(varKey) Then
            dict(varKey) = varKleinste(lngZeile, 1)
        End If
    Else
        dict(varKey) = varKleinste(lngZeile, 1)
    End If
Next lngZeile
'-----------------------------
' aus Dictionary schreiben
'-----------------------------
For lngZeile = 1 To UBound(varListe, 1)
    varKey = varListe(lngZeile, 1)
    varKleinste(lngZeile, 1) = dict(varKey)
Next lngZeile
'-----------------------------
' ins Blatt übergeben
'-----------------------------
ThisWorkbook.Names("Kleinste").RefersToRange.Value = varKleinste
End Sub

habs geschaft =D selbst nicht dran geglaubt , aber funkt!! vielen vielen DANK!!!!