Excel zoekfunctie uitbreiden

[Repsac]

Goedemiddag,

Kunnen jullie mij helpen met het bestandje Bekijk bijlage Zoeken.xlsm

Ik wil graag zodra ik wat intyp bij ''DEP'' dat er met die inhoud van de kolom beneden direct een bijbehorend tabje geopend wordt met alles waar bij DEP dat getal staat.

Nu is het zo dat alles waar bijvoorbeeld 6 bij "DEP" staat in de DataSheet blijft staan.

Er moet dus bij het indrukken van Zoeken een tabje met de naam 6 of een ander nummer gemaakt worden.

Ook moet er dan in het vervolg dat tabje geopend worden mochten er meer records met 6 zijn.

is dit mogelijk?

GRoet R

 

[HSV]

Zoiets?

Sub Zoeken()
If IsError(Evaluate("'" & Range("H4").Value & "'!A1")) Then
    Sheets.Add(, Sheets(Sheets.Count)).Name = CStr(Range("H4").Value)
    End If
 With Sheets(CStr(Sheets("datasheet").Range("H4").Value))
    .Cells(1).CurrentRegion.ClearContents
    Range("List").AdvancedFilter 2, Range("Zoeken"), .Cells(1)
 End With
End Sub

 

[Repsac]

HSV,

Allereerst bedankt voor je reactie. Ik ben niet erg sterk met VBA. Kunt u dat voor mij in het bestandje toevoegen op de juiste manier?

Gr.

 

[HSV]

Je kan de code van het forum kopiëren, en plakken op de plaats van jouw code.

 

[Repsac]

HSV,

Precies zoiets, hij werkt perfect. Kan er ook ingezet worden dat het tabje meteen geopend wordt bij de 2e keer dat je een waarde invoert?

Bedankt voor je hulp!

R

 

[HSV]

Boven 'End With' zet je:

[COLOR=#0000ff] .Activate[/COLOR]

 

[Repsac]

Werkt perfect! Dank hiervoor.

 

[Repsac]

Eigenlijk wil ik nog een andere optie voorleggen.

Is het mogelijk dat zodra "6" wordt ingevuld niet een tabje aangemaakt wordt met 6 maar dat naast de tabel een tabel wordt gezet waar de gegevens aangepast kunnen worden die niet in het tabel thuis horen.
Dus als het ware een soort gegevenskaart van het gegeven 6.

dan zou het eruit moeten zien als het tabel en dan daarnaast de extra gegevens die elke dag aangepast kunnen worden.

Is dit ook mogelijk? dan kan ik daarna kijken welke layout van de gegevens we willen gebruiken.

Het tabel met gegevens veranderd namelijk constant.

Groet, R

 

[HSV]

Plaats een voorbeeld-bestand met het gewenste resultaat.

 

[Repsac]

Bekijk bijlage Gegevensblad.xlsm

Dit zou het dan ongeveer moeten worden.

Alleen dit gegevensblad is dus voor elke waarde bij DEP. weer anders.
De gegevens wil ik later wel nog beter kunnen maken qua Layout. dus als er gelinkt kan worden naar een ander blad zou dat ook mooi zijn.

Groet, R

 

[Repsac]

Ik bedenk me nu net dat het misschien praktischer is als er gelijk met het nieuwe tabblad een sheet wordt geopend die ik al heb als voorbeeld.
en dat er dan meteen een "HOME" link wordt getoond die direct toegang geeft tot de DataSheet.

Dit is makkelijker denk ik.

Groet,

 

[HSV]

Het spijt me; misschien dat er iemand beter in raadsels oplossen is dan ik.

 

[Repsac]

HSV,

Sorry voor de onduidelijkheid misschien :d.

Die eerste opzet werkt perfect. ik denk dat ik daarmee door moet gaan.

Kunt u daar misschien aan toevoegen dat onder de gegevens uit de tabel, de inhoud van "Sheet1" gekopieerd moet worden.
Dan kan ik sheet1 maken met de template die ik heb. Die is echter vertrouwelijk.

Groet

 

[HSV]

Zoiets?

Sub Zoeken()
If IsError(Evaluate("'" & Range("H4").Value & "'!A1")) Then
    Sheets.Add(, Sheets(Sheets.Count)).Name = CStr(Range("H4").Value)
    End If
 With Sheets(CStr(Sheets("datasheet").Range("H4").Value))
  .Cells.Clear
    Range("List").AdvancedFilter 2, Range("Zoeken"), .Cells(1)
[COLOR=#0000ff]    Sheets("datasheet").UsedRange.Copy .Cells(Rows.Count, 1).End(xlUp).Offset(3)[/COLOR]
    .Activate
 End With
End Sub

 

[Repsac]

Ja dit is precies wat ik bedoel!

Bedankt voor je hulp!

Groet R

 

[Repsac]

Beste HSV,

Ik loop toch nog ergens tegenaan.

Mocht ik nu dezelfde waarde voor de 2e keer opvragen past hij het hele tabje "6" aan.

Dit moet dus eigenlijk alleen de data zijn wat hij uit de tabel kopieert en niet weer opnieuw de datasheet zoals in de laatste formule.

Als het tabje al bestaat dus alleen de data uit het tabelletje vernieuwen...Kan dat?

Gr.

 

[HSV]

Verwijder alle bladen behalve datasheet voor een frisse start.

Sub Zoeken()
If IsError(Evaluate("'" & Range("H4").Value & "'!A1")) Then
    Sheets.Add(, Sheets(Sheets.Count)).Name = CStr(Range("H4").Value)
   Sheets("datasheet").UsedRange.Copy Sheets(CStr(Sheets("datasheet").Range("H4").Value)).Cells(1, 12)
 End If
 With Sheets(CStr(Sheets("datasheet").Range("H4").Value))
     .Cells(1).CurrentRegion.ClearContents
    Range("List").AdvancedFilter 2, Range("Zoeken"), .Cells(1)
    .Activate
 End With
End Sub

 

[Repsac]

Toppie!:thumb::thumb::thumb: