• 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.

Gegevens zoeken uit ander blad

Status
Niet open voor verdere reacties.

Jarodxxx

Gebruiker
Lid geworden
26 nov 2006
Berichten
243
Hallo!

Ik heb vba-code gegeschreven (zie programmacode van blad "Home") (en wat zoeken) -> zie testbestand welke als je een nummer "1000" opgeeft in cel B5 of de naam "Brussel" in D5, alle nummers opzoekt uit het blad "Test Blad 1" de code kijkt voor het nummer "1000" vanaf rij A7 naar beneden en kijkt dan opzij. Voor "Brussel naar B7 en dan links en rechts. Werkt prima zou je denken, da's waar!, alleen wat mij niet lukt is om als ik bijvoorbeeld zoek op "1000" dat ik dan bijvoorbeeld alleen de gegevens van Rij 6 krijg en en Rij 9 ofzo en de rest niet + dat hij dan in het blad "Home" dit zet waar ik dat wil.

Wat ik zoek is dat ik kan bepalen waar ik het neer wil zetten, dit lukt al wel met rij A33 of hoger, maar niet met meerder Bijvoobeeld ook die gegevens vanaf A14 (2x op het blad "Home")

Iemand die kan assisteren?

Jarod.
 

Bijlagen

Laatst bewerkt:
Andere methode mag natuurlijk ook

Hallo!

Een andere methode mag natuurlijk ook!
Mocht dat nog nie duidelijk zijn:-)

JC.
 
Ik heb vba-code gegeschreven

Yeah right... :rolleyes: mij komt die code althans bekend voor...

Wat wil je nu eigenlijk doen? Dat is mij niet echt duidelijk? Naar waar moeten de gegevens gezet worden?

BTW:

pas jouw code aan: een autofilter is handiger dan de Find functie.

Wigi
 
ik heb wordt ik vond:-)

Ah Wigi,

Zelf braaf aangepast dan:-), zo was 't niet bedoeld, meer bij de uitleg, naja anyway!
hekel aan wiel 2x uitvinden, credit voor 'n ander!

M'n M$ academics boek ligt hier niet, kun je ff uitwijden?
Meestal tegenwoordig: snap de code wel, maar begrijp 't nog niet zonder:-)

JC.
 
Laatst bewerkt:
ça va.

Leg eerst uit - in duidelijke termen en ook in volzinnen - wat je wilt dat de code doet. Dan zien we wel verder.

Wigi
 
Jarodxxx,
Is het dit wat ge bedoeld ?
=ALS(ISGETAL(KLEINSTE(ALS('Test Blad 1'!$A$7:$A$100=$L$7;RIJ('Test Blad 1'!$A$7:$A$100));RIJ()-RIJ($M$7)+1)); INDIRECT(ADRES(KLEINSTE(ALS('Test Blad 1'!$A$7:$A$100=$L$7;RIJ('Test Blad 1'!$A$7:$A$100));RIJ()-RIJ($M$7)+1); KOLOM('Test Blad 1'!$B$7)));"")
Ingeven met Ctrl+Shift+Enter
 
Laatst bewerkt:
In vol zinnen

we hebben de onderdelen:

Sheet "Home"
Sheet "Test bestand 1"

op de sheet "home" moet je bij B5 (of ander als ik dat kies) een waarde in kunnen geven vb nr 1000
afhankelijk van de kolom die ik instel (kies) wordt na ingeven B5 in het "test bestand 1" gekeken of dezelfde waarde voorkomt
Daarna worden de rijen gekopieerd uit bv kolom D en G of C en Z kies.
Daarna worden deze waarden weergegeven in Sheet "home" waar ik dat wil

daarnaast moet het mogelijk zijn om in de sheet "home" ook de gegevens op te halen (uit de kolommen die ik ingesteld heb) uit bv "test bestand 2" een andere sheet dus.

zo duidelijk genoeg zo niet, wat weet je nog niet?

bvd,

JC.
 
Zoiets dan?

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range, rngToDo As Range, firstAddress As String, intRijKeuze As Integer
    If Target.Count > 1 Then Exit Sub
    
    If Target.Address = "$B$5" Then
        Application.ScreenUpdating = False
        Range("A32").CurrentRegion.Offset(1).ClearContents
        intRijKeuze = Application.InputBox("Geef in welke rij je wilt waaruit je de gegevens ophaalt." _
                        & vbCr & vbCr & "Kies een getal tussen 4 en 10", "Rij ingave", 4, , , , , 1)
        Set rngToDo = Sheets("Test Blad 1").Range("A7", Sheets("Test Blad 1").Range("A7").End(xlDown))
        Set c = rngToDo.Find(Target, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                c.Resize(, 3).Copy
                Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                c.Offset(, intRijKeuze - c.Column).Copy
                Cells(Range("A" & Rows.Count).End(xlUp).Row, intRijKeuze).PasteSpecial xlPasteValues
                Set c = rngToDo.FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
        Application.EnableEvents = False
        Range("D5").ClearContents
        Application.EnableEvents = True
    ElseIf Target.Address = "$D$5" Then
        Application.ScreenUpdating = False
        Range("A32").CurrentRegion.Offset(1).ClearContents
        intRijKeuze = Application.InputBox("Geef in welke rij je wilt waaruit je de gegevens ophaalt." _
                        & vbCr & vbCr & "Kies een getal tussen 4 en 10", "Rij ingave", 4, , , , , 1)
        Set rngToDo = Sheets("Test Blad 1").Range("B7", Sheets("Test Blad 1").Range("B7").End(xlDown))
        Set c = rngToDo.Find(Target, LookIn:=xlValues, lookat:=xlPart)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                c.Offset(, -1).Resize(, 3).Copy
                Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                c.Offset(, intRijKeuze - c.Column).Copy
                Cells(Range("A" & Rows.Count).End(xlUp).Row, intRijKeuze).PasteSpecial xlPasteValues
                Set c = rngToDo.FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
        Application.EnableEvents = False
        Range("E5").ClearContents
        Application.EnableEvents = True
    End If
    Target.Select
    Application.ScreenUpdating = True
End Sub

Wigi
 
Almost good!

Wigi klasse!

....maar (opbouwende kritiek heet dit:-))

met het opzoeken bedoelde ik automatisch aan de hand van wat ik in MVB Script editor heb ingesteld. Zal het duidelijker proberen te maken!

de bladen "Home" en "Test Blad 1"

-op het blad "Home" vul ik op B5 in 1000
-de code kijkt naar "Test Blad 1" kolom A vanaf rij 7, vergelijkt
- van alle rijen met "1000" (kolom A) pakt hij ook de gegevens die ik heb ingesteld
Zeg ik in de code altijd kolom C en G en V mee kopieren of wat ik maar ingesteld heb
dit moet dan gekopieerd kunnen worden naar bv A33 en dan de kolom C = kolom B en G kan naar C of D als ik dat wil etc

Dus samengevat. ik kies 1000 in "home" en krijg dan bij A33 de gegevens van de rijen met "1000", en alleen de kolommen die ik in de code aangaf en zet dit in op "home"in de kolommen die ik in de code ingesteld heb.

en dit moet met verschillende gegevens en bladen kunnen dus bv naast b5 en de gegevens uit "Test Blad 1" bij A33, G10 en dan vanaf G20 ofzo uit het "Test Blad 2"

ik hoop zo duidelijker....:D
 
Laatst bewerkt:
Ik denk dat ik het begrepen heb, maar euh, dat gaat helemaal niet simpel zijn :confused:
 
Test dit eens uit:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range, rngToDo As Range, firstAddress As String, sKolomKeuze As String
    Dim sKolGestript As String, i As Integer, shTestBlad1 As Object
    If Target.Count > 1 Then Exit Sub
    
    Set shTestBlad1 = Sheets("Test Blad 1")
    
    If Target.Address = "$B$5" Then
        Application.ScreenUpdating = False
        Range("A32").CurrentRegion.Offset(1).ClearContents
        sKolomKeuze = Application.InputBox("Geef in welke kolommen je wilt kopiëren." & vbCr & vbCr & _
                        "Bv. G,C,V (vergeet comma's niet, ook geen spaties gebruiken", "Rij ingave", , , , , , 2)
        Set rngToDo = shTestBlad1.Range("A7", shTestBlad1.Range("A7").End(xlDown))
        Set c = rngToDo.Find(Target, after:=shTestBlad1.Cells(Rows.Count, rngToDo.Column).End(xlUp), LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                c.Copy
                Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                
                sKolGestript = Replace(Trim(sKolomKeuze), ",", "")
                For i = 1 To Len(sKolGestript)
                    shTestBlad1.Range(Mid(sKolGestript, i, 1) & c.Row).Copy
                    Cells(Range("A" & Rows.Count).End(xlUp).Row, i + 1).PasteSpecial xlPasteValues
                Next i
                
                Set c = rngToDo.FindNext(c)                
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
        Application.EnableEvents = False
        Range("D5").ClearContents
        Application.EnableEvents = True
    ElseIf Target.Address = "$D$5" Then
        Application.ScreenUpdating = False
        Range("A32").CurrentRegion.Offset(1).ClearContents
        sKolomKeuze = Application.InputBox("Geef in welke kolommen je wilt kopiëren." & vbCr & vbCr & _
                        "Bv. G,C,V (vergeet comma's niet, ook geen spaties gebruiken", "Rij ingave", , , , , , 2)
        Set rngToDo = shTestBlad1.Range("B7", shTestBlad1.Range("B7").End(xlDown))
        Set c = rngToDo.Find(Target, after:=shTestBlad1.Cells(Rows.Count, rngToDo.Column).End(xlUp), LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                c.Copy
                Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                
                sKolGestript = Replace(Trim(sKolomKeuze), ",", "")
                For i = 1 To Len(sKolGestript)
                    shTestBlad1.Range(Mid(sKolGestript, i, 1) & c.Row).Copy
                    Cells(Range("A" & Rows.Count).End(xlUp).Row, i + 1).PasteSpecial xlPasteValues
                Next i
                
                Set c = rngToDo.FindNext(c)                
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
        Application.EnableEvents = False
        Range("E5").ClearContents
        Application.EnableEvents = True
    End If
    Target.Select
    Application.ScreenUpdating = True
End Sub

Dit doet de meerdere kolommen alvast al.

Over de meerdere tabbladen en posities waar de gegevens moeten komen is nog niets gedaan. Ik vrees dat dat toch veel van mijn tijd gaat innemen om die code te schrijven.

Wigi
 
Jarodxxx,
Bekijk dit is. Ik denk dat deze formule voldoet aan uw wensen.
Klik op de knop KIES & KLIK en kies vervolgens een nummer.
De gegevens zullen dan aangepast worden.
 

Bijlagen

Top Job

Werkt prachtig! en al een 2e stap in de goede richting!

Bestand van albert moet ik thuis doen (openen kan niet)
Maar nu moet ik het elke keer instellen kan dit ook 1x daarna niet, en pas als ik het weer wil aanpassen idd?
En wat nou als ik kies kolom G die wordt nu gekopieerd naar klom B in de sheet "home", maar ik wil G op C hebben staan en b blijft dus leeg

dus zeg maar kolom G (uit Test Blad 1) wil ik op kolom C (naar "home") en kolom Z wil ik op kolom I.
1x instellen daarna automatisch (instelling moet hij dus soort van onthouden??)

Dit is echt klasse werk!

JC
 
Hier dan maar weer.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range, rngToDo As Range, firstAddress As String, shTestBlad1 As Object
    If Target.Count > 1 Then Exit Sub
    
    Set shTestBlad1 = Sheets("Test Blad 1")
    
    If Target.Address = "$B$5" Then
        Application.ScreenUpdating = False
        Range("A32").CurrentRegion.Offset(1).ClearContents
        Set rngToDo = shTestBlad1.Range("A7", shTestBlad1.Range("A7").End(xlDown))
        Set c = rngToDo.Find(Target, after:=shTestBlad1.Cells(Rows.Count, rngToDo.Column).End(xlUp), LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                c.Copy
                Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                
                'verander hier G in de 1ste regel en C in de 2de regel
                shTestBlad1.Range("G" & c.Row).Copy
                Range("C" & Range("A" & Rows.Count).End(xlUp).Row).PasteSpecial xlPasteValues
                
                'verander hier Z in de 1ste regel en I in de 2de regel
                shTestBlad1.Range("Z" & c.Row).Copy
                Range("I" & Range("A" & Rows.Count).End(xlUp).Row).PasteSpecial xlPasteValues
                
                Set c = rngToDo.FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
        Application.EnableEvents = False
        Range("D5").ClearContents
        Application.EnableEvents = True
    ElseIf Target.Address = "$D$5" Then
        Application.ScreenUpdating = False
        Range("A32").CurrentRegion.Offset(1).ClearContents
        Set rngToDo = shTestBlad1.Range("B7", shTestBlad1.Range("B7").End(xlDown))
        Set c = rngToDo.Find(Target, after:=shTestBlad1.Cells(Rows.Count, rngToDo.Column).End(xlUp), LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                c.Copy
                Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                
                'verander hier G in de 1ste regel en C in de 2de regel
                shTestBlad1.Range("G" & c.Row).Copy
                Range("C" & Range("A" & Rows.Count).End(xlUp).Row).PasteSpecial xlPasteValues
                
                'verander hier Z in de 1ste regel en I in de 2de regel
                shTestBlad1.Range("Z" & c.Row).Copy
                Range("I" & Range("A" & Rows.Count).End(xlUp).Row).PasteSpecial xlPasteValues
                
                Set c = rngToDo.FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
        Application.EnableEvents = False
        Range("E5").ClearContents
        Application.EnableEvents = True
    End If
    Target.Select
    Application.ScreenUpdating = True
End Sub

Zie de opmerkingen voor aanpassingen.

Wigi
 
Een Autofilter gebruiken is beter dan de Find functie gebruiken als je vrij veel rijen in je bestand hebt. In de helpfiles en op internet vind je hier zeker code van. Je kan ook gewoon een macro opnemen en de code wat opkuisen.

Wigi
 
Klasse Wigi!

Bedankt man!

Ik zal eens op zoek, sneller = beter, je laat de code nu kijken naar de gegevens op het testblad, als ik nou zou besluiten om dit bestand buiten deze excelsheet te plaatsen dan moet ik verwijzen naar het nieuwe excel bestand

Diskdrive:\[TestBlad1]Blad1! als voorbeeld, maar euh dan ???? en volgens mij moet ik een andere term gebruiken dan Sheets toch?

Set shTestBlad1 = Sheets("TestBlad1")

Dat verwijzen naar andere bestanden zou handig zijn om te weten, ik zal zoeken, als 't niet veel werk is dan please een oplossing, volgens mij als je 't weet is 't nie zo moeilijk?!

tx

JC
 
Prima ondersteuning

Werkt bij mij ook dat voorbeeld, sleutel en pruts wel even tot werkbaar bij mijn bestand
maar 't gaf geen antwoord op mijn vraag over de gegevens in een appart bestand plaatsen

hoe doe je zoiets? (zie ook vorige vraag)

Groet,

JC.

ps: Alvast Prettige Kerstdagen!
 
... sleutel en pruts wel even tot werkbaar bij mijn bestand

Doe gerust.

maar 't gaf geen antwoord op mijn vraag over de gegevens in een appart bestand plaatsen

hoe doe je zoiets? (zie ook vorige vraag)

Rustig aan hé JC :confused: Het is niet verboden om dit zelf uit te zoeken :eek: Als ik of anderen het weten zullen we dat jou zeker niet onthouden hoor.
 
Rust zelve Wigi

Alles op z'n tijd idd!

Nee 't is meer dat ik idd de hele tijd wel aan 't prutsen ben (heb ik tenslotte dan ook patent op:-))

anyway, ik dacht meer dat je 't niet gelezen had:-)

Waar ik op doelde was de oude code met die vraag, daar werd verwezen naar een sheet in hetzelfde bestand en volgens mij kan dat ook wel naar een ander .xls bestand:-)

'k zal geduldig zoeken,wachten en straks pitten!

Greetings :thumb:

JC
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan