Minimum bepalen in een range, de waarden moeten voldoen aan een voorwaarden excel/vba

Status
Niet open voor verdere reacties.
B

BastS

Gebruiker
Lid geworden
12 mrt 2015
Berichten
52
Hallo vba-ers,

Op dit forum ben ik al een aantal keer vooruit geholpen en naarmate ik verder puzzel kan ik mezelf steeds verder redden binnen vba.
Echter momenteel wil ik een minimum bepalen. Echter de waarde die mee mogen doen voor het bepalen van een minimum moeten aan een voorwaarden voldoen.

De oplossingen van deze oplossing wil ik in een array opslaan om later weg te schrijven op een werkblad.

Ik had verwacht de oplossing te kunnen vinden met;
worksheetfunction.dmin(arg1,arg2,arg3) ,
echter deze formule blijft een error retourneren.

Code: 
ReDim sn_ll(lastrow - 3)
For h = 0 To UBound(sn_ll)

   sn_ll(h) = WorksheetFunction.DMin(Worksheets("Rekenblad").Range(Sheets("Rekenblad").Cells(3, 8 + ((b - 1) * 7)), Sheets("Rekenblad").Cells(lastrow, 8 + ((b - 1) * 7))) _
, Sheets("rekenblad").Range(Sheets("Rekenblad").Cells(3, 3), Sheets("rekenblad").Cells(lastrow, 3)),  _
Sheets("Rekenblad").Cells(h + 3, 3).Value)

Next h
Worksheets("Rekenblad").Range(Sheets("Rekenblad").Cells(3, 13 + ((b - 1) * 7)), Sheets("Rekenblad").Cells(lastrow, 14 + ((b - 1) * 7))).Value = Application.WorksheetFunction.Transpose(sn_ll)

Met de code hierboven blijf ik een error krijgen. De error luidt als volgt:
Eigenschap DMIN van klasse worksheetfunction kan niet worden opgehaald.

Ik heb op de plek van arg 1 de range van de waarde waaruit het minimum bepaald moet worden.
Hij mag alleen de waarden pakken op de positie dat arg3 gelijk is aan de waarden uit de range van arg2.

Kan iemand mij hierin helpen?
Er wordt gebruik gemaakt van excel 2013

Met vriendelijke groet,
 
Dag BastS !

Blijkbaar nog niet veel reactie op je vraag. Misschien omdat de probleemdefinitie niet echt duidelijk is.
Ik heb getracht je vraag te analyseren in combinatie met de worksheet-formule.
Zie het resultaat in bijlage.
Het is misschien niet wat je zoekt, maar het kan eventueel dienen als inspiratiebron.

Grtz,
MDN111.
 

Bijlagen

  • Min.xls
    27 KB · Weergaven: 55
Dit geeft inderdaad een zet de goede richting in. Het is bijna het resultaat wat ik zoek,
om jouw bestand even te pakken als voorbeeld. Om het misschien beter uit te leggen.

Alles in dit voorbeeld is goed op een paar dingen na.
In kolom 3 wil ik graag het minimale aantal hebben uit de kolom van arg1. Alleen wil ik het minimale
aantal hebben van de waarden uit de kolom van arg1, die in arg2 de waarde hebben van de regel waar ik kijk.

voorbeeld.jpg

In de afbeelding staat het afgebeeld. Een foto zegt waarschijnlijk meer als 1000 woorden.

Met de volgende formule in excel krijg ik het voor elkaar, alleen dit is niet in VBA.

Code: 
 Selection.FormulaArray = '"=MIN(IF(R3C3:R8762C3=RC[-9],R3C7:R8762C7))"
 
Dag BastS !

De foto maakt inderdaad veel duidelijk. Het is inderdaad niet gemakkelijk om het onder woorden te brengen.
In de nieuwe bijlage de aangepaste versie.

Let op: het is in de form van een functie. Dat wil zeggen dat Excel bij iedere wijziging en bij het openen van het bestand de functie telkens opnieuw uitvoert, wat alles zou kunnen vertragen in geval van uitgebreide tabellen. Als het te traag wordt, is een eenmalig uit te voeren macro beter, maar die past de waarden dan weer niet automatisch aan. De beste oplossing hangt af van je uiteindelijke toepassing.

Grtz,
MDN111.
 

Bijlagen

  • Min.xls
    27 KB · Weergaven: 41
Hallo MDN111,

Hardstikke bedankt voor je input tot zover.
Ik moet door een variabel bereik lopen dat kan oplopen tot 35000 rijen. Dus een eenmalig uit te voeren macro is beter.
Ik was van mening dat dit eenvoudig aan te passen was. Echter ik blijf een foutmelding krijgen.

Code: 
    Dim sn_b, sn_c
    
    sn_b = Worksheets("Rekenblad").Range("c3", ("c" & lastrow))
    sn_c = Worksheets("Rekenblad").Range(Sheets("Rekenblad").Cells(3, 7 + ((b - 1) * 6)), Sheets("Rekenblad").Cells(lastrow, 7 + ((b - 1) * 6)))
    
    For i = 0 To (lastrow - 3)
        For h = LBound(sn_b) To UBound(sn_b)
            If sn_b(h) = sn_b(i) Then
                If IsEmpty(m) Then
                    m = sn_c(h)
                Else
                    If sn_c(h) < m Then
                        m = sn_c(h)
                    End If
                End If
            End If
        Next h
    sn_a(i) = m
    Next i
    Worksheets("Rekenblad").Range(Sheets("Rekenblad").Cells(3, 12 + ((b - 1) * 6)), Sheets("Rekenblad").Cells(lastrow, 12 + ((b - 1) * 6))).Value = Application.Transpose(sn_a)

Dit is de code die ik tot nu toe heb, echter hij geeft aan dat het "subscript out of range" is. Dit doet hij op deze regel:
Code: 
     If sn_b(h) = sn_b(i) Then

Enig idee hoe dit mogelijk is?
 
Dag BastS !

Het is nogal moeilijk om een goed zicht te krijgen op jou code.

Op het eerste zicht springt het volgende in het oog:

  • Je brengt Ranges naar de arrays sn_b en sn_c. Dat zijn per definitie tweedimensionele arrays waarvan de index begint met 1, ongeacht het Option Base statement. Dan benader je die met "sn_b(h)". Dat is de reden van de foutmelding, denk ik. Je moet dus twee indexen opgeven, bijvoorbeeld "sn_b(h,1)".
  • Met het statement "If sn_b(h) = sn_b(i) Then" vergelijk je twee elementen uit dezelfde array met elkaar. Is dat de bedoeling?
  • Plots duikt er een array "sn_a" op uit het niets. Vermoedelijk om de waarden voor de 3de kolom in te stockeren. Als dat een 1-dimensionele array is, kan je die niet wegschrijven naar een Range.
Voortbordurend op de bijlage van #4 had ik een macro gemaakt. Die werkte maar was veel te traag voor een sheet met 35000 lijnen. Na herwerken is de snelheid nu aannemelijk. Misschien kan je daar mee verder gaan. De bijlage bevat nog maar 100 lijnen want een bestand van 35000 lijnen was 3 Mb en dat kan men niet uploaden.

Grtz,
MDN111.
 

Bijlagen

  • Min - Copy.xls
    58,5 KB · Weergaven: 61
Hallo MDN111,

Het is maar goed dat de dag nog niet voorbij is. Bij deze ben je de held van de dag!!!!!
Code: 
    Dim sn_b, sn_c
    
    sn_b = Worksheets("Rekenblad").Range("c3", ("c" & lastrow))
    sn_c = Worksheets("Rekenblad").Range(Sheets("Rekenblad").Cells(3, 7 + ((b - 1) * 6)), Sheets("Rekenblad").Cells(lastrow, 7 + ((b - 1) * 6)))
    
    For i = 0 To (lastrow - 3)
       For h = LBound(sn_b, 1) To UBound(sn_b, 1)
            If sn_b(h, 1) = sn_b(i + 1, 1) Then
                If IsEmpty(m) Then
                    m = sn_c(h, 1)
                Else
                    If sn_c(h, 1) < m Then
                        m = sn_c(h, 1)
                    End If
                 End If
            End If
        Next h
        sn_a(i) = m
    Next i
    Worksheets("Rekenblad").Range(Sheets("Rekenblad").Cells(3, 12 + ((b - 1) * 6)), Sheets("Rekenblad").Cells(lastrow, 12 + ((b - 1) * 6))).Value = Application.Transpose(sn_a)

Op deze manier doet de code precies wat het moet doen. En is het niet vertragend.
Ik zag in jouw code dat je een zelf gemaakt functie gebruik om de laatste rij te vinden.
Maar is het niet sneller om de volgende code te gebruiken:
Code: 
lastrow = Sheets("Sheetnaam").Cells(Rows.Count, "Betreffende kolom").End(xlUp).Row

Nogmaals zeer veel dank,

Mvg BastS
 
Te vroeg gejuigd :eek::confused:

Code: 
    sn_b = Worksheets("Rekenblad").Range("c3", ("c" & lastrow))
    sn_c = Worksheets("Rekenblad").Range(Sheets("Rekenblad").Cells(3, 7 + ((b - 1) * 6)), Sheets("Rekenblad").Cells(lastrow, 7 + ((b - 1) * 6)))
    For i = 0 To (lastrow - 3)
    m = Empty
        For h = LBound(sn_b, 1) To UBound(sn_b, 1)
            If sn_b(h, 1) = sn_b(i + 1, 1) Then
                If IsEmpty(m) Then
                    m = sn_c(h, 1)
                Else
                    If sn_c(h, 1) < m Then
                        m = sn_c(h, 1)
                    End If
                 End If
            End If
        Next h
    sn_a(i) = m
    Next i
    Worksheets("Rekenblad").Range(Sheets("Rekenblad").Cells(3, 12 + ((b - 1) * 6)), Sheets("Rekenblad").Cells(lastrow, 12 + ((b - 1) * 6))).Value = Application.Transpose(sn_a)

Dit is de werkende code.
 
Dag BastS !

Dat van die array sn_a moet ik terugnemen, want het is blijkbaar wel mogelijk om een 1-dimensionele array naar een Range te schrijven, zoals jij trouwens in je code gedaan hebt.

Dat van die functie LastRow() is puur de macht der gewoonte. Ooit heb ik eens een functie gevonden op het www om de LastCell te bepalen en daaruit functies LastRow() en LastCol() afgeleid en sindsdien gebruik ik die. De functie met ".End(xlUp).Row" gebruik ik niet maar die is zeker even goed. Het verschil is dat je met LastRow() de laatste rij met gegevens kan terugvinden van een hele sheet, terwijl je met de functie met ".End(xlUp).Row" de laatste gegevensrij van een bepaalde kolom terugvindt.

Grtz,
MDN111.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan