hulp gevraagd om een overzicht te maken

[AugustKoster]

Geacht forum,

Ik ben in Excel vaak aan het kopiëren en plakken om tot een bestand te komen dat op het eerste tabblad van het voorbeeld staat.
De andere tabbladen zijn dienstregelingen van buslijnen. Een lijn bestaat uit meerdere ritten meestal in twee richtingen. De richting wordt aangegeven met a en b.
Ik ben op zoek naar een mogelijkheid om het eerste werkblad uit het bijgaande bestand geautomatiseerd aan te maken. Ik heb een voorbeeld gemaakt. In dit voorbeeld staan nu 3 lijnen. Dit zijn er altijd veel meer. Ik heb dit zo gedaan omdat ik maar 100 Kb mag uploaden.
In het voorbeeld is gezocht naar alle ritten die vertrekken vanaf halte Amsterdam, CS IJsei.
Dit betekent dat elke keer wanneer er een bus vanaf halte Amsterdam, CS IJsei vertrekt, dit in het bestand moet worden opgenomen. Er zijn meerdere haltes waar ik zo’n overzicht van moet hebben.
Nu maak ik dit overzicht door op de naam te zoeken, dit te kopiëren, te plakken en te transponeren. Dit is een erg omslachtige manier en omdat dit vaak voorkomt zoek naar een andere oplossing.

Ik ben erg benieuwd of (en hoe) dit mogelijk is binnen Excel. Ik ben zelf al bezig geweest met enkele zoekfuncties, maar ik kom er telkens niet uit.

Alvast hartelijk dank voor de genomen moeite. Mochten er vragen zijn, dan verneem ik die graag.

 

[HSV]

Ik weet niet of je in de problemen komt met dubbele namen (aangemerkt met V of A in kolom B).
Het rode in de code zou je uit een cel moeten halen, zodat de code flexibel wordt.
Ik heb je bladen iets aangepast (zodat de afstand overal gelijk is), waardoor de waarden in kolom D gemakkelijk wordt opgehaald.

Sub hsv()
Dim sh As Variant, C As Variant, sq As Long
Sheets("A'dam, CS IJsei").Range(Range("A2"), Range("A2").End(xlDown).Rows.Resize(, 4)).ClearContents
  For Each sh In Sheets
    If sh.Name <> "A'dam, CS IJsei" Then
Set C = sh.Columns(1).Find("[COLOR="#FF0000"]Amsterdam, CS IJsei[/COLOR]", , xlValues, xlWhole)
  sq = C.Offset(, 1).Resize(, sh.Cells(C.Row, Columns.Count).End(xlToLeft).Column - 2).Columns.Count
If Not C Is Nothing Then
  With Sheets("A'dam, CS IJsei")
    .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(sq, 2) = Application.Transpose(sh.Cells(3, 3).Resize(2, sq))
    '.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(sq) = Application.Transpose(sh.Cells(4, 3).Resize(, sq))
    .Cells(Rows.Count, 3).End(xlUp).Offset(1).Resize(sq) = Application.Transpose(C.Offset(, 2).Resize(, sq))
    .Columns(3).NumberFormat = "hh:mm:ss"
    .Cells(Rows.Count, 4).End(xlUp).Offset(1).Resize(sq) = C.Offset(36)
     End With
     End If
    End If
  Next sh
With Sheets("A'dam, CS IJsei")
    .Range("C1:C" & .Cells(Rows.Count, 3).End(xlUp).Row).AutoFilter 1, "", xlOr, "|", False
    .AutoFilter.Range.Offset(1).Resize(, 4).SpecialCells(12).Delete shift:=xlUp
    .ShowAllData
 End With
End Sub

 

[AugustKoster]

Hallo Harry,
Het heeft even geduurd maar hier een reactie.
Alvast bedankt voor wat je gedaan hebt. Het was voor mij als leek even zoeken hoe ik hier mee om moest gaan maar ik ben er achter.
Ook of het a of b moet zijn is geen probleem want dit kan er in de regel gemakkelijk bij gezet worden. Ik heb dit geprobeerd en dit werkt.
Echter , in het voorbeeld staan drie werkbladen (=drie lijnen). In de praktijk kunnen dit er wel vijftig zijn. Ik heb hetzelfde bestand aangevuld met meer dan dertig bladen. Dan werkt het niet. De volgende tekst komt op het scherm: fout 91 tijdens uitvoering Opjectvariabele of Blokvariabele With is niet ingesteld. Wanneer ik naar fout opsporing ga dan geeft deze aan dat de fout in regel 9 zit.

Verder heb ik nog een andere vraag: Hoe copieer ik deze Macro in een bestaand bestand.

Ik hoop dat je me met deze vragen kunt helpen.
Ik ben je er erg dankbaar voor.

Met vriendelijke groet,

August Koster

 

[HSV]

Hallo August,

Volgens mij bedoel je deze coderegel.

.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(sq, 2) = Application.Transpose(sh.Cells(3, 3).Resize(2, sq))

Dat komt doordat alle bladen niet gelijk zijn van structuur.
Zie tabblad 124 van jouw gepost bestandje.
Hier ontbreekt lijnnummer op rij 3.
Deze heb ik even toegevoegd in het door mij gepost bestandje.

2: Je kan de code gewoon kopiëren uit module1 door eerst Alt+F11 te drukken.

Schroom niet om te vragen als je het niet begrijpt.

 

[AugustKoster]

Hallo Harry,
Ik heb de bestanden allemaal aangepast. Ik heb op regel 3 en 39 het lijnnummer staan en op regel 4 en 40 het rit nummer. Toch doet dit het niet.

gr. August

 

[HSV]

Misschien is het handig dat je het bestand hier neer zet mocht het niet te groot worden.
Anders tot aan het blad waar het fout gaat.
Kun je zien in het eerste blad welke nummers je hebt verkregen in kolom A.

 

[AugustKoster]

een groter bestand

Hallo Harry,

In de bijlage een iets groter bestand.

Ik hoop dat je er uit komt.

groeten, August Koster

 

[HSV]

Probeer het zo eens August.

Sub hsv()
Dim sh As Variant, C As Variant, sq As Long
Sheets("A'dam, CS IJsei").Range(Range("A2"), Range("A2").End(xlDown).Rows.Resize(, 4)).ClearContents
  For Each sh In Sheets
    If sh.Name <> "A'dam, CS IJsei" Then
Set C = sh.Columns(1).Find("Amsterdam, CS IJsei", , xlValues, xlWhole)
 If Not C Is Nothing Then
  sq = C.Offset(, 1).Resize(, sh.Cells(C.Row, Columns.Count).End(xlToLeft).Column - 2).Columns.Count

  With Sheets("A'dam, CS IJsei")
    .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(sq, 2) = Application.Transpose(sh.Cells(3, 3).Resize(2, sq))
    .Cells(Rows.Count, 3).End(xlUp).Offset(1).Resize(sq) = Application.Transpose(C.Offset(, 2).Resize(, sq))
    .Columns(3).NumberFormat = "hh:mm:ss"
    .Cells(Rows.Count, 4).End(xlUp).Offset(1).Resize(sq) = C.Offset(36)
     End With
     End If
   End If
  Next sh
With Sheets("A'dam, CS IJsei")
    .Range("C1:C" & .Cells(Rows.Count, 3).End(xlUp).Row).AutoFilter 1, "", xlOr, "|", False
    .AutoFilter.Range.Offset(1, -2).Resize(, 4).SpecialCells(12).Delete Shift:=xlUp
    .ShowAllData
 End With
End Sub

 

[AugustKoster]

Hallo Harry,
Het lijkt dat het werkt.
Ik ga het de komende dagen controleren en laat je dan weten of het allemaal juist is.

Groeten, August

 

[AugustKoster]

Hallo Harry,

We hebben het op een aantal verschillende manieren uitgeprobeerd. Ik vind het fantastisch zoals het werkt. Ik ben een aantal problemen tegen gekomen.

1) Bij lijn 110 bij rit 1003 staat nu dat de bestemming Purmerend, Tramplein is maar de eindbestemming is Edam, busstation is. Dit kun je in het blad 110 zien omdat er verder geen tijden staan.

2) De vertrektijden van na 12 uur s'nachts horen nog bij de vorige dag. Dit loopt tot 3 uur s'nachts. hiervoor moet bij de tijden 24 uur worden opgeteld omdat wij de bestanden kunnen sorteren op tijd. De ritten na 0:00 moeten dan onder aan de lijst staan. Zou jij dit sorteren ook mee kunnen nemen.

3) We hebben nu lijnnummer in regel 3 en 39 staan en ritnummer in regel 4 en 40. Het komt voor dat er veel meer haltes zijn. Kunnen we bijvoorbeeld op regel 3 en 100 en het ritnummer op 4 en 101 krijgen zodat we deze grotere bestanden ook kunnen bewerken?

4) Wij hebben ook een controle uitgevoerd met hetzelfde bestand maar met de naam "Edam, BusstationV" Bij de uitkomsten komen alleen de ritten van de lijn a er uit en niet van lijn b.

Ik hoop dat je me hier mee kunt helpen . Dat zou helemaal perfect zijn. Ik heb een mail gekregen waarin staat dat de vraag afgerond en als afgehandeld moet worden beschouwd. Kan ik jouw E mailadres krijgen zodat ik nog wat kan vragen? Groeten August Koster kosteraugust@gmail.com