meerdere codes wegschrijven naar blad 2

[ronsom]

Hallo,

Ik heb eens een code gekregen via dit forum en heb deze een klein beetje uitgebreid.
Nu wil ik vragen of het mogelijk is hier nog iets aan toe te voegen.
De code kijkt naar de kolom Container op blad 1 en kijkt dan hoeveel containers er uniek zijn. Er wordt gekeken naar datum/tijd/activiteit en naam om te kijken welke containers uniek zijn.
Het aantal unieke containers telt hij dan op in de laatste kolom.
Nu staan de container nummers in 1 kolom met een spatie ertussen en een .(punt) aan het einde.
Mijn vraag is of er verschillende gegevens naar blad 2 geschreven kunnen worden zoals in het voorbeeld bestand.
Dus simpel gezegd een tekst naar kolommen of zoiets.

De punt is ook niet nodig op het blad 2.

 

[VenA]

Aan de handtekening te zien heb je deze code van @Timshel gekregen. Met een paar kleine aanpassingen is er wel iets van te maken om het geheel een beetje op te splitsen. Het text to columns gedeelte laat ik maar even aan jou over.

Sub tsh()
    Dim Br, Bq, d
    Dim i As Long, j As Long
    [COLOR="#0000FF"]Set d = CreateObject("Scripting.Dictionary")[/COLOR]
    Br = Sheets(1).ListObjects(1).DataBodyRange
    With CreateObject("System.Collections.Arraylist")
        For i = 1 To UBound(Br)
            Br(i, 20) = 0
            Bq = Split(Trim(Replace(Br(i, 11), ".", "")))
            For j = 0 To UBound(Bq)
                If Not .Contains(CStr(Bq(j)) & "_" & Br(i, 2) & Br(i, 5) & Br(i, 6) & "_" & Br(i, 1)) Then Br(i, 20) = Br(i, 20) + 1
                .Add CStr(Bq(j)) & "_" & Br(i, 2) & Br(i, 5) & Br(i, 6) & "_" & Br(i, 1)
                [COLOR="#0000FF"]d(Br(i, 1) + Br(i, 2) & "|" & Br(i, 5) & "|" & "|" & Br(i, 6)) = d(Br(i, 1) + Br(i, 2) & "|" & Br(i, 5) & "|" & "|" & Br(i, 6)) & Bq(j) & "|"[/COLOR]
            Next
        Next
    End With
    Sheets(1).ListObjects(1).DataBodyRange = Br
    [COLOR="#0000FF"]With Sheets(2)
      .Cells(1, 10).Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    End With[/COLOR]
End Sub

 

[ronsom]

Hallo VeNa,

Bedankt voor je reactie, ik ga ermee aan de slag.