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

Gegroepeerde rijen, kopiëren waarde hoofdgroep naar subgroep

Status
Niet open voor verdere reacties.
A

Ario

Gebruiker
Lid geworden
16 aug 2019
Berichten
5
Beste forumleden, ik heb een .xlsx ontvangen met (volgens mij) gegroepeerde rijen, in 3 niveaus. Ook wordt per groep een subtotaal getoond. Dat subtotaal mag er van mij uit.
Wat ik zoek, is het expliciet maken (kopiëren) van de waarde van de hoofdgroep in een extra kolom naast de subgroep en de sub-subgroep, en van de waarde van de subgroep bij de sub-subgroep.
Hier een voorbeeld van hoe het aanvankelijk is:
2019-08-16 09_25_54-Window.jpg

En hier een voorbeeld van hoe het zou moeten worden:
2019-08-16 09_25_31-Window.jpg

Heb nu twee dagen allerlei tips doorgenomen, maar ik zoek denk ik op de verkeerde termen.

Reuze bedankt voor jullie ideeën !
Fijne dag en groeten van Arie
 
Laatst bewerkt:
Plaats het bestand even. (ontdaan van gevoelige info)
 
Plaats het excelbestand gewoon hier. Met in de eerste tab de uitgangssituatie en in de tweede het gewenste resultaat. Waarom wil je van chaos weer chaos maken?
 
Ah, ik zie nu dat je bij snel reageren geen xls kunt bijvoegen, maar via gewoon reageren wel ;-)
Excuses.
Hier nogmaals de 2 files.
 

Bijlagen

  • Uitgangspunt.xlsx
    10,4 KB · Weergaven: 9
  • Gewenst-resultaat.xlsx
    10,8 KB · Weergaven: 12
Waarom wil je van chaos weer chaos maken?
Klik om te vergroten...

Met een macro kan je de gegevens opschonen en in een tabel zetten. Klik op de blauwe knop en zie het resultaat en de de tab 'Resultaat'

Code: 
Sub VenA()
  ReDim ar1(10, 0)
  With Sheets("Data")
    On Error Resume Next
    .Columns(2).SpecialCells(4).FormulaR1C1 = "=R[1]C"
    .Columns(3).SpecialCells(4).FormulaR1C1 = "=R[-1]C"
    ar = .Cells(1).CurrentRegion
    For j = 2 To UBound(ar)
      If Left(ar(j, 1), 3) = "PRJ" Then c00 = ar(j, 1)
      If Left(ar(j, 1), 4) = "Taak" Then
        x = UBound(ar1, 2)
        ar1(0, x) = c00
        ar1(1, x) = ar(j, 1)
        For jj = 2 To 10
          ar1(jj, x) = ar(j, jj)
          If jj = 4 And IsDate(ar(j, jj)) Then ar1(jj, x) = CDbl(ar(j, jj))
        Next jj
        ReDim Preserve ar1(10, x + 1)
      End If
    Next j
  End With
  With Sheets("Resultaat").ListObjects(1)
    If .ListRows.Count Then .DataBodyRange.Delete
    .ListRows.Add.Range.Resize(x + 1, 11) = Application.Transpose(ar1)
  End With
End Sub
 

Bijlagen

  • Uitgangspunt (1).xlsb
    20,7 KB · Weergaven: 9
Reuze bedankt voor de hulp & voor de zeer snelle reactie. Ik ga er mee aan de slag en houd u op de hoogte.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan