macro verbeteren

[Gerard2348]

Beste helpers,

Onderstaande macro heb ik samengesteld uit diverse voorbeelden. Ik vraag mij af of deze macro niet beter kan.

Sub Per_dag()

Application.ScreenUpdating = False
i = Sheets("per dag").Rows(4).Find(Day(Sheets("per dag").Range("A3")))

With Sheets("Per dag").Range("B5:AH150")
.ClearContents
.NumberFormat = "0.0_ ;[Red]-0.0 "
End With

With Sheets("Blad1")
    
 For Each cell In Range("R21:R" & Range("R1500").End(xlUp).Row)
 If cell.Value <> "" Then

    cell.Offset(0, 7).Copy
    Sheets("per dag").Cells(Rows.Count, 2).End(xlUp).Offset(1).PasteSpecial xlPasteValues

    cell.Offset(0, -2).Copy
    Sheets("per dag").Cells(Rows.Count, i + 2).End(xlUp).Offset(1).PasteSpecial xlPasteValues

 End If

 Next cell
 End With

Application.ScreenUpdating = True

End Sub

Met vriendelijke groet

Bekijk bijlage naar dag.xlsm

 

[jkpieterse]

Een simpele verbetering: niet kopieren maar de waarde direct overzetten en berekenen tijdelijk uitzetten. Ook twee punten toegevoegd voor "Range(":

Sub Per_dag()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    i = Sheets("per dag").Rows(4).Find(Day(Sheets("per dag").Range("A3")))

    With Sheets("Per dag").Range("B5:AH150")
        .ClearContents
        .NumberFormat = "0.0_ ;[Red]-0.0 "
    End With
    With Sheets("Blad1")
        For Each cell In .Range("R21:R" & .Range("R1500").End(xlUp).Row)
            If cell.Value <> "" Then
                Sheets("per dag").Cells(Rows.Count, 2).End(xlUp).Offset(1).Value = cell.Offset(0, 7).Value
                Sheets("per dag").Cells(Rows.Count, i + 2).End(xlUp).Offset(1).Value = cell.Offset(0, -2).Value
            End If
        Next cell
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

[Gerard2348]

Zo dan.....
Das snel. Dit geldt voor de oplossing en de code :d

Helemaal top. Wat voor functie heeft het toevoegen van de punt voor "range(" ?

Groetjes,

Geer.

 

[edmoor]

@jkpieterse:
Daarnaast heb je de inspringpunten gecorrigeerd en de overbodige lege regels verwijderd.
Het is maar een klein stukje code maar als je dat consequent op die manier doet is het ZO belangrijk voor de leesbaarheid!
Ik zou wel de Calculation eerst in een Long variabele zetten, dan op xlCalculationManual zetten en aan het einde weer terug zetten wat in de variabele staat.

@Gerard:
De . voor Range houdt in dat de Range wordt gebruikt die hoort bij het object dat is genoemd in het With statement.

 

[Gerard2348]

dank je voor de uitleg.

groet geer

 

[VenA]

Gebruik geen samengevoegde cellen.

Sub VenA()
  Sheets("Per dag").Range("B5:AH150").ClearContents
  With Sheets("Blad1").Cells(20, 2).CurrentRegion
   .AutoFilter 17, "<>"
   .Offset(1).Resize(, 1).Copy Sheets("per dag").[B5]
   .Offset(1, 14).Resize(, 1).Copy Sheets("per dag").[B5].Offset(, Day(Sheets("per dag").[A3]))
   .AutoFilter
  End With
End Sub

 

[Gerard2348]

Ha VenA,

Jij ook bedankt voor jouw oplossing. En ik weet dat samengevoegde cellen voor problemen kunnen zorgen. Jouw code werkt inderdaad goed wanneer er geen samengevoegde cellen instaan. De oplossing van Jan Karel werkt wel met samengevoegde cellen. En ik weet dat het eigenwijs klinkt maar ik ga zijn zijn code gebruiken. Dit omdat de macro wordt geïntegreerd in een groter geheel waar helaas samengevoegde cellen in staan. Deze zijn niet zomaar te wijzigen vanwege de lay-out. Maar nogmaals voor beide oplossingen mijn hartelijke dank.

Ik blijf mij steeds verbazen over de aangebrachte oplossingen :thumb: Helaas ligt het niet in mijn vermogen om zelf dit soort dingen te kunnen produceren.

Groet Geer

 

[HSV]

Helaas ligt het niet in mijn vermogen om zelf dit soort dingen te kunnen produceren.
Groet Geer

Geeft niets, al doende leert men.
Als er geen vragen waren moeten wij op zoek naar een andere hobby.

 

[snb]

...waar helaas samengevoegde cellen in staan. Deze zijn niet zomaar te wijzigen vanwege de lay-out.

Start dan eens een draad hoe je samengevoegde cellen kunt vermijden zonder enige wijziging aan de layout.
De antwoorden zullen je verbazen.

 

[Gerard2348]

Ik ga mij daar eens in verdiepen.