Waarde geven aan cel dmv coordinaten

[Antoonh]

Hallo,

Het lijkt me dat dit niet erg moeilijk is, maar ik ben niet goed in VBA:

Kan je als je in blad 1 van excel een lijst met x coordinaten, y coordinaten en de bijbehorende diepten hebt, deze diepten in een coordinatenstelsel in blad 2 zetten? Er staan maar een paar coordinaten gegeven, de meeste cellen in blad 2 zullen dus leeg zijn.
In de bijlage staat een beginbestandje zonder code.

Met vriendelijke groet,

Antoon

 

[Mark xl]

Gewoon deze formule in D2 plakken en doortrekken
=INDEX(Ark2!$A$1:$N$41;VERGELIJKEN(Ark1!B2;Ark2!$1:$1;0);VERGELIJKEN(Ark1!A2;Ark2!$A:$A;0))

aanpassing:
je moet dan natuurlijk wel coordinaten opgeven die daadwerkelijk aanwezig zijn.
EN: X = horizontaal, Y =verticaal

 

[Antoonh]

Bedankt voor het antwoord, het is echter niet wat ik bedoel. Ik wil dat in ark 2 de cellen (met de coordinaten die in ark 1 staan) ingevuld worden met de diepte. Ik wil de waarden dus niet UIT het coordinatenstelsel halen, maar er IN zetten. Omdat er maar een paar coordinaten zijn gegeven wordt dus niet iedere cel ingevuld. De cellen die niet gevuld worden moeten gewoon leeg blijven.

 

[Mark xl]

zo dan!

Sub fyld_depth()
Dim vArk1 As Variant
Dim vArk2 As Variant
Dim XArk2 As Variant
Dim YArk2 As Variant
Dim xCord As Object, yCord As Object
Dim i As Long

'Hent Ark 1 og Ark 2
vArk1 = Sheets("Ark1").UsedRange 
With Sheets("Ark2")
    .Range("A1") = 0   'Har brug for en nøgle i hver dictionary record
    vArk2 = .UsedRange
    XArk2 = .Range("A1", .Range("IV1").End(xlToLeft))
    YArk2 = .Range("A1", .Range("A65535").End(xlUp))
End With

'Søg X, Y
Set xCord = CreateObject("Scripting.dictionary")
Set yCord = CreateObject("Scripting.dictionary")

For i = 1 To UBound(XArk2, 2)
    xCord.Add CStr(XArk2(1, i)), i
Next
For i = 1 To UBound(YArk2, 1)
    yCord.Add CStr(YArk2(i, 1)), i
Next

For i = 2 To UBound(vArk1)  'fyld matrix x,y
    
    On Error Resume Next    'hvis  x ,y findes ikke
    vArk2(yCord(CStr((vArk1(i, 1)))), xCord(CStr(vArk1(i, 2)))) = vArk1(i, 3)

Next

'opdater Ark2 med nye værdier
Sheets("Ark2").Range("A1").Resize(UBound(vArk2, 1), UBound(vArk2, 2)) = vArk2

Set xCord = Nothing
Set yCord = Nothing

End Sub

 

[Antoonh]

Het is dus niet zo simpel als ik dacht! Het werkt precies zoals ik bedoelde, bedankt! Nu nog even uitzoeken hoe dit allemaal precies werkt...

 

[Mark xl]

Je kan dit ook oplossen met for..each cell in range ellende,

Dat is wellicht duidelijker maar veel trager en gaat je opbreken op grote celbereiken.

 

[Antoonh]

Ok Ik kan VBA-code niet zelf maken, als ik een code krijg kan ik hem wel uitpluizen, maar zelf vanuit niks beginnen lukt me (nog) niet... Waarom staan er trouwens Noorse comments bij? Ik zit in Noorwegen namelijk, of is dat niet toevallig?

 

[Mark xl]

Nee die heb ik getyped.
ik heb 4 jaar lang dagelijks scandinavisch(deens) gesproken , en herken "ark1" als zijnde scandinavische Excel. dus vandaar.

 

[Antoonh]

Aha, grappig Nogmaals bedankt en ik ga ermee verder!