• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Voorwaardelijk data schrijven in tabel

Status
Niet open voor verdere reacties.
D

donndz

Gebruiker
Lid geworden
1 sep 2009
Berichten
27
Goedemiddag,

Ik wil op basis van twee voorwaarde met een macro een set data schrijven (plakken) in een tabel.
De twee voorwaarde zijn de X-as en Y-as van de tabel.

Ik zit al even te stoeien maar ik kom er niet meer uit, graag uw hulp!

In de bijlage een voorbeeld.
 

Bijlagen

Probeer eerste zelf eens wat! Uit je bestand blijkt niet dat je dat al gedaan hebt.
Erg moeilijk is het niet, je hebt maar een paar functies nodig.
Ik zal wat aanwijzingen geven:
1. Eerst de rechtertabel wissen, want bij elke nieuwe keuze in C4 moeten de vorige resultaten vervallen.
2. Je bepaalt welke rij (van de 4) rechts moet worden ingevuld, dwz dat c4 vergeleken moet worden met G7:G10. dat kan bv. met VERGELIJKEN (MATCH).
3. Je doorloopt B8:B29 (dat kan met For - Next) en je bekijkt van elke waarde die je tegenkomt in welke kolom van de rechtertabel (H : P) die waarde thuishoort. dat kan ook weer met VERGELIJKEN (MATCH).
4. Het rij- en kolomnummer (berekend in 2 en 3 ) bepalen samen de cel waarin de betreffende waarde van B8:B29 moet komen.
Hiermee moet vrijwel iedereen die zich een beetje in vba heeft verdiept, jouw probleem kunnen oplossen.
 
Beste Zapatr,

Bedankt voor de input dusver. Met celverwijzingen als MATCH en INDEX is het verhaal inderdaad ook regelen.
Het bestand waarvoor het is gaat richting de 20k invoerregels, worden wel erg veel formules op deze manier.

Ook kan ik mezelf inbeelden dat de verwerking in VBA anders werkt dan deze verwijzingen (?

Wat nog wel een goede toevoeging is; elke combinatie van 2 voorwaarde in de linkertabel(len) komt maar 1 keer voor. Alleen de nieuwe toevoer in de tabel linksonder zou weggeschreven moeten/kunnen worden in de rechter tabel.
 
Mijn bericht hierboven heeft wel degelijk betrekking op een vba-oplossing (zie: "for-next" en "match"). Met match vind je het snelst de kolom waarin de waarde geschreven moet worden.
Je schrijft: alleen nieuwe invoer moet weggeschreven worden. Dan moet natuurlijk wel bekend zijn wat nieuw is en wat oud. En als je in C4 een nieuwe optie kiest (bv. C), dan kunnen toch A, B, en D niet meer van toepassing zijn?
 
Oke, dan was het voor mij niet helemaal duidelijk. Ik dacht dat je het over celverwijzingen had (zie verwerking in bijlage).

Tevens in de bijlage een iets andere opzet, die moet het verhaal een stuk verduidelijken hoop ik.
Nieuwe invoer is uniek in de combinatie voorwaarde 1 en 2.

Nieuwe invoer bepalen is lastig inderdaad, mogelijk de VBA starten na veranderen van een bepaalde cel in de nieuw toegevoegde regel?
 

Bijlagen

@donndz,
Jouw andere opzet verandert niet zo veel aan de macro.
In plaats van tijdens de uitvoer van de macro 1 x de rij te bepalen waarin de gegevens moeten worden geschreven, moet je dat nu bij elke rij doen in B3 : D15, dus je moet de berekening van de rij in de For-Nextlus opnemen. Voor het overige kun je nog steeds toepassen wat ik in bericht #2 schreef. Nieuwe gegevens zijn geen probleem, bij elke uitvoer van de macro wordt de gehele tabel laten doorlopen. Ik kan nu wel die macro hier neerzetten, maar probeer dat nou zelf eens, van klakkeloos oplossingen van anderen overnemen leer je niets.
 
@VenA, draaitabel moet inderdaad lukken bedenk ik me nu maar het jammere is dat ik in het voorbeeld er vanuit ga dat de bron-data (linker tabel) bewaard blijft. In het 'echte' bestand volgen deze specifieke waarde uit een een check waarvoor ik bepaalde parameters moet instellen en bij iedere check anders zijn (erg lastig om daar te diep op in te gaan). Ik zou bij voorkeur werken zonder tussentabel waarin de data onder elkaar wordt opgeslagen waarop basis dan een draaitabel gemaakt kan worden. Ik hoop dat het duidelijk is. Des al niet te min heb ik je oplossing (incl. tussentabel) wel moeten en kunnen toepassen. Niet de meest fraaie in mijn beleving maar wel effectief, bedankt!

@zapatr, ik snap je gedachte maar het leren stond in deze de productietijd in de weg. Ik had gehoopt snel tot een oplossing te komen om een praktisch en urgent probleem op te lossen. Ik kan VBA een beetje volgen en inderdaad toepassen na wat specifiek gegoogle of van tijd tot tijd struinen op dit forum. Helaas vind ik het erg lastig de vba-taal goed te doorgronden. Ik had op dit forum gehoopt op hulp en niet op een les :D Hoe dan ook bedankt voor je input!
 
Ik zie in jouw voorbeeldje alleen een tabel en een "Andersom" gepresteerde tabel. Over welke tussentabel heb je het? Als het
(erg lastig om daar te diep op in te gaan)
Klik om te vergroten...
. Gaat het natuurlijk onmogelijk worden om een passend antwoord te vinden.
 
De suggestie van VenA voor een oplossing met een draaitabel lijkt mij erg goed.
@donndz: Jammer dat je mijn 'les' uit bericht #2 niet op prijs hebt gesteld en zelfs niet een begin hebt gemaakt om die toe te passen. Hieronder dan een voorbeeld van hoe het zou kunnen (maar er zijn ook andere, snellere, en kortere oplossingen mogelijk), gebaseerd op het bestand bij bericht #5, en samengesteld volgens de aanwijzingen die ik in bericht #2 gaf.
Code: 
Sub macro1()
Dim k As Integer, r As Integer, x As Integer
'Deze macro werd geschreven door Zapatr
With Sheets("Blad1")
Application.ScreenUpdating = False
.Range("i2:q5").ClearContents
For x = 4 To .Cells(.Rows.Count, 2).End(xlUp).Row
    If .Cells(x, 2) > 0 Then
        r = 1 + WorksheetFunction.Match(.Cells(x, 2), .Range("h2:h6"), 0)
        k = 8 + WorksheetFunction.Match(.Cells(x, 3), .Range("i1:q1"), 0)
        .Cells(r, k).Value = .Cells(x, 4).Value
    End If
Next x
Application.ScreenUpdating = True
End With
End Sub
 
Beste zapatr, bedankt. Ik heb je oplossing toegepast en het werkt.
Je les wordt, achteraf, zeer gewaardeerd! Was even even puzzelen om het aan te passen.


Code: 
Sub Macro1()
    Sheets("Blad1").Select
    Range("S2:U5").Select
    Selection.Copy
    Application.Goto Reference:=Worksheets("blad1").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Onderstaand deel gemaakt door Zaptar
Dim k As Integer, r As Integer, x As Integer
With Sheets("dempingswaarde")
Application.ScreenUpdating = False
.Range("g2:s89").ClearContents
'x= geeft de kolomnummer van de waarde die verplaatst moet worden .rows.count de 1e regel van het bereik waar het in moet komen.
For x = 4 To .Cells(.Rows.Count, 2).End(xlUp).Row
'de x, geeft het kolomnummer aan die gecheckt word top >0
    If .Cells(x, 2) > 0 Then
'de  r = geeft het rijnummer waar het bereik begint
'de x, geeft de kolom aan waarop basis de waarde gematched moet worden binnen het daarna aangegeven bereik
        r = 1 + WorksheetFunction.Match(.Cells(x, 2), .Range("f2:f89"), 0)
'de  k = geeft de kolomnummer waar het bereik begint
'de x, geeft de kolom aan waarop basis de waarde gematched moet worden binnen het daarna aangegeven bereik
        k = 6 + WorksheetFunction.Match(.Cells(x, 3), .Range("g1:s1"), 0)
'de x, geeft de kolom aan wdie gekopieerd moet worden
        .Cells(r, k).Value = .Cells(x, 4).Value
    End If
Next x
Application.ScreenUpdating = True
End With
End Sub
 
De regels (boven "Dim...") waarin je in Blad1 wat kopieert kun je inkorten, nl:
Code: 
With Sheets("Blad1")
.Range("S2:U5").Copy .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0)
End With
Hoe het gekopieerde in verband staat met het vervolg van de code (die in het blad "dempingswaarde" wordt uitgevoerd), zie ik niet; maar als het bij jou werkt, dan is het ok.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan