Sorteren met behoud van opmaak

[BasHobus]

Beste Mensen,

Voor mijn stage ben ik een bestand aan het maken waarin zij de uren per project bij kunnen houden. Hiervoor zou ik graag het bestand laten sorteren op projectnummer. Echter heeft niet ieder project het zelfde aantal regels onder zich. Dit heb ik proberen op te vangen door het projectnummer door te trekken op iedere regel. Wanneer ik dan sorteer klopt de opmaak niet meer.
Bekijk bijlage voorbeeld2.xlsm
Is er een mogelijkheid om de projecten zo te sorteren dat de opmaak ook mee verandert?

 

[Gijsbert1]

Hoi BasHobus,

Misschien is het een idee om de input los te maken van de output. (Dit staat nu door elkaar)
Dan kun je werken met een draaitabel bijvoorbeeld.

 

[HSV]

Het zou ook eens leuk zijn als je reageerde op een reactie van je vragen.
Misschien zijn de helpers dan eerder geneigd om er nog energie in te steken.

Doe er je voordeel mee.

 

[BasHobus]

De opzet is zo vooraf gemaakt door het bedrijf. Er zijn meerdere taps per product dat ze verkopen. Het is hierdoor heel lastig om alles uit elkaar te halen.

 

[keesbl]

Misschien zo, met een iets andere indeling, en draaitabel.
Wel even nog een beetje fatsoeneren met de celranden.

Vermijd overigens samengevoegde cellen.

Kees

 

[BasHobus]

Ik zal morgen ernaar kijken. Kan namelijk alleen bij het bestand op mijn stagesdres

 

[VenA]

In navolging van jouw andere draadje

Sub VenA()
For Each ar In Blad13.Columns(1).SpecialCells(-4123).Areas
  If ar.Rows.Count > 1 Then
    ar.Resize(ar.Rows.Count, 4).Sort ar(1).Offset(, 2)
    ar.Offset(1, 5).Resize(ar.Rows.Count, 4).Sort ar(1).Offset(, 6)
  End If
Next ar
End Sub

 

[BasHobus]

VenA

Is er een mogelijkheid om deze aan te passen zodat deze ook in andere tabbladen werkt?
Er komt namelijk per Type product een anderen urenlijst, waardoor er meerdere werkbladen komen met de zelfde format

 

[VenA]

Probeer het zo maar eens.

Sub VenA()
For Each sh In Sheets
  If sh.Name <> "Personeel" Then
    For Each ar In sh.Columns(1).SpecialCells(-4123).Areas
      If ar.Rows.Count > 1 Then
        ar.Resize(ar.Rows.Count, 4).Sort ar(1).Offset(, 2)
        ar.Offset(1, 5).Resize(ar.Rows.Count, 4).Sort ar(1).Offset(, 6)
      End If
    Next ar
  End If
Next sh
End Sub

 

[BasHobus]

Ik krijg hem helaas niet werkend, heb in blad 2(2) de format opgesteld zoals hij uiteindelijk is geworden.

Is het mogelijk om de formule ook hierop werkend te krijgen?
Bekijk bijlage voorbeeld2.xlsm

 

[VenA]

Wat lukt er zoal niet? Als je elke keer de opzet anders maakt dan kan ik aan de gang blijven.

.SpecialCells(-4123).Areas kijkt of er formules in een cel staan dat je deze nu o.a in kolom J hebt staan dan zal je dat aan moeten passen. Met Offset en Resize kan je het te sorteren bereik manipuleren. Hetzelfde geldt voor de Offset die achter .Sort staat. Dus ook dit zal je aan moeten passen. Het is dus niet meer dan een beetje tellen en de code aanpassen.

Bouw onderbrekingspunten in of gebruik een Msgbox om het e.e.a te controleren. Maar beter is het om de hele opzet weg te gooien en geen gebruik te maken van VBA.

Code met een msgbox zodat je zien wat ik bedoel.

Sub VenA()
For Each sh In Sheets
  If sh.Name <> "Personeel" Then
    For Each ar In sh.Columns("J:N").SpecialCells(-4123).Areas
      If ar.Rows.Count > 1 Then
        MsgBox "Dit is het bereik van ar: " & ar.Offset(, -2).Resize(ar.Rows.Count, 3).Address & Chr(10) & "Hierop wordt gesorteerd: " & ar(1).Offset(, -1).Address
        ar.Offset(, -2).Resize(ar.Rows.Count, 3).Sort ar(1).Offset(, -1)
      End If
    Next ar
  End If
Next sh
End Sub

 

[BasHobus]

Dankjewel het is gelukt.