tabel met waarden omzetten naar andere tabel uit geinterpoleerde gegevens

[sph]

Ik heb een rekenmachine/tool in Blad1

Deze interpoleert tussen bepaalde waarden waardoor een cont.rating wordt berekend uit een min.liftset.

Door in Blad1!J4 wat in te voeren rolt er wat uit in Blad1!L4.

Nu heb ik een random tabel gemaakt in Blad2
De gegevens zijn alle dingen die ik graag automatisch wil invoeren in Blad1!J4

Adhv deze gegevens zou ik graag in Blad3 deze kopie willen zien met de uitvoer van Blad1!L4


Ik ben er eigenlijk van overtuigd dat wat ik wil, onmogelijk is, maar 1 van de knappe koppen hier heeft vast wel een alternatieve wijze.

Excuses voor de knullige uitleg, maar kan het niet anders onder woorden brengen.





Bekijk bijlage Map1.xlsx

 

[MarcelBeug]

Dat kan met de volgende simplistische macro.

Sub VulBlad3()

    Dim r%, k%
    
    For r = 4 To 153
        For k = 2 To 17
            Sheets("Blad1").Range("J4") = Sheets("Blad2").Cells(r, k)
            Sheets("Blad3").Cells(r, k) = Sheets("Blad1").Range("L4")
        Next k
    Next r
    
End Sub

Zie bijlage.

 

[sph]

Knap antwoord, nog knapper dat je mijn vraag begreep
Heel erg bedankt, dit werkt!

 

[HSV]

Ondanks opgelost leek het me wel wat om de 'simplistische' code iets meer snelheid te geven.

Sub hsv()
Dim sq, r As Long, k As Long, E, F, H, I
Application.ScreenUpdating = False
sq = Sheets("Blad2").Range("b4:q153").Value
For r = 1 To UBound(sq)
  For k = 1 To UBound(sq, 2)
        E = Evaluate("min(if(blad1!b4:b53>=" & sq(r, k) & "/1000,blad1!b4:b53))") * 1000
        F = Replace(Evaluate("max(if(blad1!b4:b53>=" & sq(r, k) & "/1000,blad1!c4:c53))"), ",", ".")
        H = Blad1.Cells(Application.Match(sq(r, k) / 1000, Blad1.Columns(2), 1), 2) * 1000
        I = Replace(Blad1.Cells(Application.Match(sq(r, k) / 1000, Blad1.Columns(2), 1), 3).Value, ",", ".")
    sq(r, k) = Evaluate("if(" & sq(r, k) & "<=7000,""max 2000"",iferror(round(" & sq(r, k) & "/(" & I & "-(" & sq(r, k) & "-" & H & ")*(" & I & "-" & F & ")/(" & E & "-" & H & ")),0),round(" & sq(r, k) & "/(" & I & "-(" & sq(r, k) & "-" & H & ")*(" & I & "-" & F & ")),0)))")
  Next k
 Next r
 Sheets("blad3").Cells(4, 2).Resize(UBound(sq), UBound(sq, 2)) = sq
End Sub

 

[MarcelBeug]

Echt iets voor een regenachtige zondagmiddag. :d

Ik krijg wel bizarre snelheidsverschillen:
- op mijn oude PC (2012 Intel G530T 2.00 GHz met 4,00 GB RAM) van 1,6 á 1,7 seconden voor mijn code naar zo'n 1,5 á 1,55 seconden voor de hsv-code.
- op mijn laptop (2104 Intel Core i7-40510U 2.00-2.60 GHz met 12,0 GB RAM) van 5,5 á 6,5 seconden (!) voor mijn code naar zo'n 0,7 seconden voor de hsv-code.
Beide draaien onder Windows 10.

@HSV: wat zijn jouw bevindingen qua snelheid?

 

[HSV]

Eigenlijk moet je het bereik legen in blad3 en dan de codes draaien.
Doordat ik het in een array zet en jij per cel blijft het nergens hangen in het geheugen, wat scheelt.

Pc: 2012 - Intel(R) Celeron(R) CPU 847 1.10GHz 1.10 GHz 4.0GB RAM W7 upgrade naar W10 (eigenlijk tijd voor een nieuwe dus).

Snelheid MB: 6.797 sec.
Snelheid HSV: 2.727 sec.