Gelijke waarde in kolom T, dan kolom K optellen en herplaatsen op ander tabblad

[ewh]

in de bijlage een bestandje neer gezet .
op blad1 staat data , in kolom T staan de kosten plaatsen ingevuld en die komt verschillende malen voor.
het is de bedoeling dat van dezelfde kosten plaatsen de uren in kolom K worden opgeteld en vervolgens op blad 2 geplaatst worden de kosten plaats weer in kolom T en de optellingen in kolom K

daar naast zal kolom D gevuld worden met de waarde die in kolom T2 staat als er een waarde in kolom K staat

in kolom AC hebben wij een paar kosten verklaringen opgenomen , als Kolom T is gevuld dan zal in kolom F de tekst van kolom AD moeten komen te staan ( die correspondeerd met de kostenplaats )

als je het bestand bekijkt is het wel duidelijk.

ben nu een maandje bezig maar het lukt me niet dus heb wat hulp nodig ( ik werk nog met excel 2003 , sorry )

Bekijk bijlage november 2016.xls

 

[VenA]

Volgens mij is/was het ook in Xl-2003 mogelijk om een tabel aan te leggen met gestructureerde data en van daaruit te werken naar een totaal overzicht dmv bv een draaitabel. Wat je met deze kleurplaten wilt maakt niet echt veel duidelijk. December is weer een nieuw bestand?

Met een draaitabel in het blad 'Pt_Kostenplaats' kan je weer verder gaan kleuren en opmaken.:d

 

[ewh]

deze oplossing had ik bedacht maar met draai tabellen ben je erg afhankelijk van de versie excel ☺

graag willen wij een VBA oplossing en de twee vraagjes verder op in mijn vraag stelling kan ik al helemaal niet oplossen met een draaitabel

 

[HSV]

Wat er verder dan onderstaande code moet gebeuren kan ik niet opmaken uit je vraag.

Sub hsv()
Dim sn, i As Long, sh As Object
sn = Sheets("blad1").Range("f5", Sheets("blad1").Cells(Rows.Count, 6).End(xlUp).Resize(, 15))
 With CreateObject("scripting.dictionary")
    For i = 1 To UBound(sn)
      .Item(sn(i, 15)) = .Item(sn(i, 15)) + sn(i, 6)
    Next i
  Set sh = Sheets("blad2")
    sh.Cells(5, 11).Resize(.Count) = Application.Transpose(.items)
    sh.Cells(5, 19).Resize(.Count) = Application.Transpose(.keys)
 End With
End Sub

 

[ewh]

dat is wat we wilde, bedankt

het tweede deel van de code is dat op blad2 :

kolom O gevuld worden met de waarde die in kolom T2 staat ( nu staat er 10,00 ) als er een waarde in kolom K staat. Staat er niets in kolom K dan wordt kolom dus niet gevuld

nu zal kolom Kolom W gevuld worden met de formule die op het blad staat

 

[HSV]

Wat betekent 'kolom T2' in Excel?

Edit: Ik denk dat ik er al uit ben.

 sh.Cells(5, 11).Resize(.Count) = Application.Transpose(.items)
[COLOR="#0000FF"] sh.Cells(5, 15).Resize(.Count) = sh.Range("T2").Value[/COLOR]
 sh.Cells(5, 19).Resize(.Count) = Application.Transpose(.keys)

 

[ewh]

top

ben weer een stukje verder, wellicht dat er nog een vraagje komt over dit item en dat heeft te amken met de laatste twee regels in het voorbeeld bestand
dat is materiaal en zal apart moeten blijven , deze mogen dus niet gesommeerd worden
ga eens puzzeleln of me dat lukt

 

[HSV]

Het antwoord ligt hier al voor je klaar, maar zelf uitvinden is het beste.

Hint...het zijn maar twee tekens.

 

[ewh]

HSV je maakt me gek :shocked:, ik denk dat ik je code begrijp maar snap die twee tekens nog niet echt.
als er in kolom F het woord materiaal staat dan die regel niet mag er niet gesommeerd worden

het vervelende is dat we van te voren niet weten hoeveel keer het woord materiaal voorkomt ( hoeveel regels ), wel is zeker dat zij altijd als laatste toegevoegd worden.

 

[HSV]

Jij schreef: het zijn de laatste twee regels, dan was het Ubound(sn) -2

Nu wordt het:

[COLOR=#0000ff]If InStr(sn(i, 1), "Matriaal") = 0 Then [/COLOR].Item(sn(i, 15)) = .Item(sn(i, 15)) + sn(i, 6)

Denk erom dat er in het bestand Matriaal i.p.v. Materiaal staat; zo ook in de code de verkeerde schrijfwijze.

 

[ewh]

was ik niet op gekomen
dus je code in de HSV code gezet maar krijg een fout melding bij = . item "ongeldige verwijzing"

ik zal hem ongetwijfeld ergens verkeerd in je code hebben gezet . Wat zo het kunnen zijn ?

 

[HSV]

De zwarte tekst van de code stond er al, de blauwe codetekst ervoor zetten net als ik heb gedaan.

 

[ewh]

top werkt als een trein. bedankt
maar nu dan toch de ham vraag hoe krijg ik de regels met matriaal, elk afzonderlijk nu naar blad 2 ?

 

[HSV]

En waar zouden die moeten komen te staan?

Welke gegevens van de regels met Materiaal.

 

[ewh]

de waarde in kolom K , O en T gewoon onderaan nadat HSV is uitgevoerd
mooi zou zijn als het tekst in kolom F ook mee gaat
alles gaat naar blad 2

 

[HSV]

Zoiets?

Sub hsv()
Dim sn, i As Long, sh As Object
sn = Sheets("blad1").Range("f5", Sheets("blad1").Cells(Rows.Count, 6).End(xlUp).Resize(, 15))
 With CreateObject("scripting.dictionary")
    For i = 1 To UBound(sn)
     If InStr(sn(i, 1), "Matriaal") = 0 Then
       .Item(sn(i, 15)) = .Item(sn(i, 15)) + sn(i, 6)
     Else
       .Item(sn(i, 1) & sn(i, 15)) = .Item(sn(i, 1) & sn(i, 15)) + 1
     End If
    Next i
  Set sh = Sheets("blad2")
    sh.Cells(5, 11).Resize(.Count) = Application.Transpose(.items)
    sh.Cells(5, 15).Resize(.Count) = sh.Range("T2").Value
    sh.Cells(5, 19).Resize(.Count) = Application.Transpose(.keys)
 End With
End Sub

 

[ewh]

Bijna
onder in de HSV code heb je geschreven "sh.Cells(5, 15).Resize(.Count) = sh.Range("T2").Value"
en deze overschrijft ( natuurlijk ) de waarde van het materiaal


en de tekst "matriaal"staat nu in kolom T moet in kolom F staan

 

[HSV]

Beter?

Sub hsv()
Dim sn, i As Long, sh As Object
sn = Sheets("blad1").Range("f5", Sheets("blad1").Cells(Rows.Count, 6).End(xlUp).Resize(, 15))
ReDim arr(0)
 With CreateObject("scripting.dictionary")
    For i = 1 To UBound(sn)
     If InStr(sn(i, 1), "Matriaal") = 0 Then
       .Item(sn(i, 15)) = .Item(sn(i, 15)) + sn(i, 6)
     Else
       .Item(sn(i, 1)) = .Item(sn(i, 1)) + 1
          arr(UBound(arr)) = sn(i, 10)
        ReDim Preserve arr(UBound(arr) + 1)
     End If
    Next i
  Set sh = Sheets("blad2")
    sh.Cells(5, 11).Resize(.Count) = Application.Transpose(.items)
    sh.Cells(5, 15).Resize(.Count - UBound(arr)) = sh.Range("T2").Value
    sh.Cells(Rows.Count, 15).End(xlUp).Offset(1).Resize(UBound(arr)) = Application.Transpose(arr)
    sh.Cells(5, 19).Resize(.Count) = Application.Transpose(.keys)
 End With
End Sub

 

[ewh]

Bijna
de tekst uit kolom F moet ook weer in kolom F komen en de tekst uit kolom T moet ook in kolom T komen

ben echt blij met je hulp

 

[HSV]

Een kostenplaats heeft verscheidene teksten in kolom F.

Voor kolom T verander je 19 in 20.

 sh.Cells(5, [COLOR="#0000FF"]19[/COLOR]).Resize(.Count) = Application.Transpose(.keys)