Laagste waarde per rij

[Thoralf]

Dan nog even een afsluiting:
Ik heb mijn idee ook omgezet naar VBA en dat staat nu op
members.chello.nl/g.hendriksen/roostervb.htm
Deze oplossing is volledig geparametriseerd en onafhankelijk van formules voor het berekenen van de waardes in het te onderzoeken bereik.
Deze oplossing gaat wel ca 12 maal trager dan de oplossing van Sylvester, maar dat wordt m.i. voor een belangrijk deel veroorzaakt door het feit dat ik er nog niet in slaag de reeks getallen uit het bereik, met hun respectievelijke rij- en kolomnummer in het geheugen te sorteren. Dat moet nu nog op een werkblad gebeuren. Verder is door middel van parameters op te geven op welk blad de invoer staat, op welk blad de uitvoer moet komen, het maximum aantal getallen per rij en per kolom in het resultaat, de begincel van het te gebruiken bereik en of er gebruik gemaakt moet worden van de laagste, of wel van de hoogste getallen.

Kortom, voor de liefhebber nog een leuk hulpmiddeltje en wellicht nog een aardige bron voor versnelling.

 

[ner0987]

Een dik jaar later en ik gebruik deze excel nog steeds dagelijks.
Nogmaals hartelijk bedankt voor de hulp die ik hier gehad heb.

Maar het is tijd voor een veranderingetje.
De macro was toen ingesteld om vanuit kolom 2 de waarde maximaal 2 keer te gebruiken, zoals ik toen gevraagd had.
Na verloop van tijd hoorde dat nog maar 1x te zijn, dus ben ik zelf in de macro gaan zoeken om dat aan te passen.
Dat is me toen ook gelukt, alleen weet ik niet meer wat ik precies heb aangepast.
Nu de dag van vandaag is het tijd om er geen restrictie meer op te leggen.

Dus met andere woorden:
Bij elke coordinaat uit kolom 1 heb ik de dichtsbijzijnde coordinaat nodig uit kolom 2.
De coordinaten uit kolom 2 mogen oneindig vaak gebruikt worden, toch zou ik het naderhand nog willen kunnen aanpassen, dus de restrictie hoeft niet uit de macro gehaald te worden. Deze op oneindig zetten indien mogelijk, en anders op 999 of dergelijke.
Zou iemand de macro kunnen inkijken en dit even aanpassen?
Graag met een woordje uitleg waar ik dit zelf in de toekomst kan aanpassen, dit mag met een comment in de macro, of via het forum.

Sub Macro2()
    Dim Itabel() As Long
    Dim Vcords() As Long
    Dim Hcords() As Long
    Dim AantalRijen As Long, AantalKolommen As Long
    Dim T As Integer, R As Range, tempR As Range, Tekst
    Dim V As Long, H As Long, Kv As Long, Kh As Long
    ActiveSheet.UsedRange.Offset(0, 2).ClearContents
    'vertikale coordingten invullen
    Set R = [A6000]: Set R = R.End(xlUp): Set tempR = Range([A1], R)
    AantalRijen = R.Row
    ReDim Vcords(AantalRijen, 2)
    For T = 1 To AantalRijen
        Tekst = Split(Cells(T, 1), "|")
        Vcords(T, 1) = Tekst(0): Vcords(T, 2) = Tekst(1)
    Next T
    'horizontale coordingten invullen
    Set R = [b6000]: Set R = R.End(xlUp): Set tempR = Range([b1], R)
    AantalKolommen = R.Row
    ReDim Hcords(AantalKolommen, 2)
    For T = 1 To AantalKolommen
        Tekst = Split(Cells(T, 2), "|")
        Hcords(T, 1) = Tekst(0): Hcords(T, 2) = Tekst(1)
    Next T
    ReDim Itabel(AantalRijen, AantalKolommen)
    'Itabel invullen
    For V = 1 To AantalRijen
        For H = 1 To AantalKolommen
            Itabel(V, H) = (Vcords(V, 1) - Hcords(H, 1)) * (Vcords(V, 1) - Hcords(H, 1)) _
            + (Vcords(V, 2) - Hcords(H, 2)) * (Vcords(V, 2) - Hcords(H, 2))
        Next H
    Next V
    ReDim Hcords(AantalKolommen)
    ReDim Vcords(AantalRijen)
    'geef de oplossing
    Application.ScreenUpdating = False
    Set R = [D1]
    For T = 1 To WorksheetFunction.Min(AantalKolommen * 2, AantalRijen)
        kleinste = 999999999
        'zoek de laagsete
        For H = 1 To AantalKolommen
            If Hcords(H) < 1 Then
                For V = 1 To AantalRijen
                    If Vcords(V) = 0 Then
                        If Itabel(V, H) < kleinste Then
                            kleinste = Itabel(V, H)
                            Kv = V
                            Kh = H
                        End If
                    End If
                Next V
            End If
        Next H
        Hcords(Kh) = Hcords(Kh) + 1
        Vcords(Kv) = Vcords(Kv) + 1
        'plaats de oplossing
        R = Sqr(kleinste)
        R(1, 2) = Kv
        R(1, 3) = Cells(Kv, 1)
        R(1, 4) = Kh
        R(1, 5) = Cells(Kh, 2)
        Set R = R(2, 1)
    Next T
    Application.ScreenUpdating = True
End Sub

Bekijk bijlage DichtsbijzijndeCoords.xlsm

Alvast bedankt!