Samenvoegen van gegevens uit twee regels op 1 regel

markremmel · 26 nov 2015

Sorry, maar ik ben een leek op VBA gebied.
Ik kom erin en kan er in kijken, maar snap er geen snars van.... helaas dus

Ik begrijp dat je graag ziet dan mensen er zelf ook iets van opsteken en zelf iets mee kunnen,.. maar met deze losse hints kom ik helaas geen stap verder aangezien ik het gewoonweg niet begrijp hoe het in elkaar zit.

Zal het topic dan maar sluiten zonder oplossing en het script gebruiken/laten zoals het nu is

Toch bedankt voor jullie input in deze en mocht iemand toch nog hulp kunnen/willen bieden dan hoor ik het wel.

markremmel · 27 nov 2015

Baal toch wel dat ik geen oplossing heb kunnen vinden voor mijn probleempje

Snb, zou je toch willen vragen of je me wilt helpen met mijn verzoekje

markremmel · 27 nov 2015

Dat is raar,.. ik krijg een bericht dat AxelCel 45 minuten geleden heeft gereageerd op het bericht,... maar ik kan niets zien

AlexCEL · 27 nov 2015

Had bericht meteen weer verwijderd... probeerde als (tussen)oplossing de tabel om te schrijven met formules, maar ontdekte nog paar niet kloppende zaken.

markremmel · 27 nov 2015

Ahhhhhhhhh,..... ok! :thumb: :d

AlexCEL · 27 nov 2015

Dit is de omgeschreven tabel met formules.

Bekijk bijlage vluchtschema 2.2.xlsm

Alleen bij de vertrekkende vlucht om 6:12u klopt nog iets niet volgens mij... Dat is niet ten gevolg van het omschrijven, maar het gaat fout in de vba-omzetting van ruwe data naar vluchttabel.

Misschien dat een VBA-goeroe (snb?

) hier nog eens naar wil kijken?

sylvester-ponte · 28 nov 2015

hoe kun je zien of er een vertrekt om aankomt?

bvb: in

Code:

21:20E	SWR770	A319	LSZH	EBBR	HBIPU

markremmel · 28 nov 2015

Hoi sylvester-ponte,

Een aankomst is vanuit LSZH naar EBBR, zoals hieronder:

Code:

21:20E	SWR770	A319	LSZH	EBBR	HBIPU

Een vertrekkend vliegtuig vanuit EBBR is:

Code:

21:20E	SWR770	A319	EBBR	LSZH	HBIPU

Hoop dat het duidelijk is

sylvester-ponte · 28 nov 2015

ik denk dat je het zo bedoeld:

Code:

Private Sub CommandButton1_Click()
   sn = Blad1.Cells(1).CurrentRegion
   
   For j = 1 To UBound(sn)
      If sn(j, 3) = sn(j + 1, 3) Then
         c00 = c00 & vbLf & Join(Array(sn(j, 1), sn(j + 1, 1), sn(j, 2), sn(j + 1, 2), sn(j, 3), sn(j, 4), sn(j, 5), sn(j + 1, 5), sn(j, 6)), "_")
         j = j + 1
 [COLOR="#FF0000"]     ElseIf sn(j, 4) = "EBBR" Then
         c00 = c00 & vbLf & Join(Array("-", sn(j, 1), "-", sn(j, 2), sn(j, 3), "-", sn(j, 4), sn(j, 5), sn(j, 6)), "_")[/COLOR]
      Else
         c00 = c00 & vbLf & Join(Array(sn(j, 1), "-", sn(j, 2), "-", sn(j, 3), sn(j, 4), sn(j, 5), "-", sn(j, 6)), "_")
      End If
   Next
   
   sn = Split(Mid(c00, 2), vbLf)
   With Blad1.Cells(1, 26)
        .CurrentRegion.ClearContents
        .Resize(UBound(sn)) = Application.Transpose(sn)
        .CurrentRegion.TextToColumns , , , , 0, 0, 0, 0, -1, "_"
    End With
End Sub

het rode is toegevoegd

markremmel · 28 nov 2015

Hoi Sylvester,

Heb het toegevoegd in de VBA omgeving en even getest op een paar regels...
Het werkt!! Helemaal super

Ik heb zojuist als test even de gehele dag van vandaag in het excel werkblad gekopieerd, alleen daar gaat het ergens fout en krijg ik de foutmelding bij het uitvoeren 'subscript valt buiten het bereik'.
Het het bestandje even hieronder toegevoegd met alle vluchten van vandaag erin,.. misschien kun jij zo zien waar het fout gaat ?

Bekijk bijlage vluchtschema 2.3.xlsm

sylvester-ponte · 28 nov 2015

hij ging buiten het gebied sn
regeltje toegevoegd aan gebied sn en teller aangepast

Code:

Private Sub CommandButton1_Click()
   Set temp = Blad1.Cells(1).CurrentRegion
   sn = temp.Resize(temp.Rows.Count + 1)
   For j = 1 To UBound(sn) - 1
      If sn(j, 3) = sn(j + 1, 3) Then
         c00 = c00 & vbLf & Join(Array(sn(j, 1), sn(j + 1, 1), sn(j, 2), sn(j + 1, 2), sn(j, 3), sn(j, 4), sn(j, 5), sn(j + 1, 5), sn(j, 6)), "_")
         j = j + 1
      ElseIf sn(j, 4) = "EBBR" Then
         c00 = c00 & vbLf & Join(Array("-", sn(j, 1), "-", sn(j, 2), sn(j, 3), "-", sn(j, 4), sn(j, 5), sn(j, 6)), "_")
      Else
         c00 = c00 & vbLf & Join(Array(sn(j, 1), "-", sn(j, 2), "-", sn(j, 3), sn(j, 4), sn(j, 5), "-", sn(j, 6)), "_")
      End If
   Next
   
   sn = Split(Mid(c00, 2), vbLf)
   With Blad1.Cells(1, 16)
        .CurrentRegion.ClearContents
        .Resize(UBound(sn)) = Application.Transpose(sn)
        .CurrentRegion.TextToColumns , , , , 0, 0, 0, 0, -1, "_"
        .CurrentRegion.Sort .Offset
    End With
End Sub

markremmel · 28 nov 2015

Nu werkt ie echt top!
Helemaal super,.. het enige wat ik nu zelf hoef te doen is het sorteren van de vluchten die alleen vertrekken vanuit BRU.
Deze worden nu onderaan geplaatst aangezien ze natuurlijk als eerste een '-' hebben staan.

Weet jij ook of onderstaande formule in VBA opgenomen kan worden:

=TEKST(LINKS(C1;2)+1&DEEL(C1;4;2);"0000")

Dit is namelijk de tijd '21:20E' omzetten naar een plat getal '2220'.
De tijd die wordt weergegeven door het systeem is UTC-tijd en voor weergave in lokale tijd (+1) laat ik het geheel eerst door die formule lopen voordat ik ze in dit werkblad zet.

Nogmaals hartelijk dank voor de support en input!!!!

sylvester-ponte · 28 nov 2015

en wat moet '23:20E' worden?

met jouw formule =TEKST(LINKS(C1;2)+1&DEEL(C1;4;2);"0000")

wordt 1229 --> 0139

ik neem aan dat dat 1329 moet zijn

AlexCEL · 28 nov 2015

Mooi. Probleem toch opgelost lijkt het. Soms baal ik ervan dat ik niet meer van VBA weet...

markremmel · 28 nov 2015

Sylvester, het is een 24-uurs notering,.. dus 1239 wordt 1339 en 2359 zou 0059 moeten worden.
Maar aangezien het dan fout insorteert mag het ook 2459 worden, dat geeft alleen maar duidelijker weer dat het en nachtvlucht is en geen vroege ochtend vlucht.

AxelCel, ja ben helemaal gelukkig!
Als we nu nog wat kleine zaken kunnen finetunen is het echt geweldig.

sylvester-ponte · 28 nov 2015

probeer deze eens:

Code:

Private Sub CommandButton1_Click()
    Set temp = Blad1.Cells(1).CurrentRegion
    sn = temp.Resize(temp.Rows.Count + 1)
    For j = 1 To UBound(sn) - 1
        t0 = WorksheetFunction.Text(CDate(Left(sn(j, 1), 5)) + 1 / 24, "hh:mm")
        t1 = WorksheetFunction.Text(CDate(Left(sn(j + 1, 1) & "00000", 5)) + 1 / 24, "hh:mm")
        If sn(j, 3) = sn(j + 1, 3) Then
            c00 = c00 & vbLf & Join(Array(t0, t1, sn(j, 2), sn(j + 1, 2), sn(j, 3), sn(j, 4), sn(j, 5), sn(j + 1, 5), sn(j, 6)), "_")
        ElseIf sn(j, 4) = "EBBR" Then
            c00 = c00 & vbLf & Join(Array("-", t0, "-", sn(j, 2), sn(j, 3), "-", sn(j, 4), sn(j, 5), sn(j, 6)), "_")
        Else
            c00 = c00 & vbLf & Join(Array(t0, "-", sn(j, 2), "-", sn(j, 3), sn(j, 4), sn(j, 5), "-", sn(j, 6)), "_")
        End If
    Next
    sn = Split(Mid(c00, 2), vbLf)
    With Blad1.Cells(1, 10)
        .CurrentRegion.ClearContents
        .Resize(UBound(sn)) = Application.Transpose(sn)
        .CurrentRegion.TextToColumns , , , , 0, 0, 0, 0, -1, "_"
        .CurrentRegion.Sort .Offset
    End With
End Sub

sylvester-ponte · 28 nov 2015

zo wordt hij 24 uurs aanduidend

Code:

Private Sub CommandButton1_Click()
    Set temp = Blad1.Cells(1).CurrentRegion
    sn = temp.Resize(temp.Rows.Count + 1)
    For j = 1 To UBound(sn) - 1
        t0 = WorksheetFunction.Text(CDate(Left(sn(j, 1), 5)) + 1 / 24, [COLOR="#FF0000"]"[hh]:mm"[/COLOR])
        t1 = WorksheetFunction.Text(CDate(Left(sn(j + 1, 1) & "00000", 5)) + 1 / 24, [COLOR="#FF0000"]"[hh]:mm[/COLOR]")
        If sn(j, 3) = sn(j + 1, 3) Then
            c00 = c00 & vbLf & Join(Array(t0, t1, sn(j, 2), sn(j + 1, 2), sn(j, 3), sn(j, 4), sn(j, 5), sn(j + 1, 5), sn(j, 6)), "_")
        ElseIf sn(j, 4) = "EBBR" Then
            c00 = c00 & vbLf & Join(Array("-", t0, "-", sn(j, 2), sn(j, 3), "-", sn(j, 4), sn(j, 5), sn(j, 6)), "_")
        Else
            c00 = c00 & vbLf & Join(Array(t0, "-", sn(j, 2), "-", sn(j, 3), sn(j, 4), sn(j, 5), "-", sn(j, 6)), "_")
        End If
    Next
    sn = Split(Mid(c00, 2), vbLf)
    With Blad1.Cells(1, 10)
        .CurrentRegion.ClearContents
        .Resize(UBound(sn)) = Application.Transpose(sn)
        .CurrentRegion.TextToColumns , , , , 0, 0, 0, 0, -1, "_"
        .CurrentRegion.Sort .Offset
    End With
End Sub

ps zet de celeigenschappen van de tijdkolommen op [uu]:mm

sylvester-ponte · 28 nov 2015

Alex, ik heb meer problemen met gewone excel formules dan met vba

wat dat betreft benijd ik jou :thumb:

markremmel · 28 nov 2015

Sylvester,

Het werk inderdaad perfect!
Maarrrrr,.... kun je layout van de tijd ook gewoon als 03:45E als 0445 weergeven, zonder verder enige opmaak?
Dus gewoon alleen 4 getallen?

Haha, sorry hierna zal ik je niet meer lastig vallen

sylvester-ponte · 28 nov 2015

ik ben benieuwd

Code:

Private Sub CommandButton1_Click()
    With Blad1.Cells(1, 10).CurrentRegion
        .ClearContents
        .NumberFormat = "@"
        Set temp = Blad1.Cells(1).CurrentRegion
        sn = Blad1.Cells(1).CurrentRegion.Resize(Blad1.Cells(1).CurrentRegion.Rows.Count + 1)
        For j = 1 To UBound(sn) - 1
            t0 = WorksheetFunction.Text(CDate(Left(sn(j, 1), 5)) + 1 / 24, "[hh]mm")
            t1 = WorksheetFunction.Text(CDate(Left(sn(j + 1, 1) & "00000", 5)) + 1 / 24, "[hh]mm")
            If sn(j, 3) = sn(j + 1, 3) Then
                Blad1.Range(Cells(j, 10), Cells(j, 18)) = Array(t0, t1, sn(j, 2), sn(j + 1, 2), sn(j, 3), sn(j, 4), sn(j, 5), sn(j + 1, 5), sn(j, 6))
            ElseIf sn(j, 4) = "EBBR" Then
                Blad1.Range(Cells(j, 10), Cells(j, 18)) = Array("-", t0, "-", sn(j, 2), sn(j, 3), "-", sn(j, 4), sn(j, 5), sn(j, 6))
            Else
                Blad1.Range(Cells(j, 10), Cells(j, 18)) = Array(t0, "-", sn(j, 2), "-", sn(j, 3), sn(j, 4), sn(j, 5), "-", sn(j, 6))
            End If
        Next
        .Sort Blad1.Cells(1, 10)
    End With
End Sub

Samenvoegen van gegevens uit twee regels op 1 regel

Gebruiker

Gebruiker

Gebruiker

Meubilair

Gebruiker

Meubilair

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Meubilair

Gebruiker

Verenigingslid

Verenigingslid

Verenigingslid

Gebruiker

Verenigingslid

Wij waarderen jouw privacy