Snipperkaart met Visual Basic

[anstof]

Ik heb nog steeds één probleempje wat al vanaf het begin niet goed gaat in mijn snipperkaart (verlofkaart). Er zijn twee tabbladen waarvan het tweede tabblad alles moet overnemen van het eerste tabblad. Het eerste tabblad is ‘Invoertijden’ en het tweede tabblad is ‘Resultaat’. Dus eigenlijk is ‘Resultaat’ een kopie van ‘Invoertijden’ en dat moet ook zo, alleen is het tabblad ‘Resultaat’ in decimalen. Wat ik in ‘Invoertijden’ ingeef komt in ‘Resultaat’ in decimalen. Tot zover niets aan de hand, ook de kleuren komen precies in beide tabbladen overeen. De fout zit in Rij 35 van het tabblad ‘Resultaat’, dit is een Rij van =SOM() per maand. Als ik in cel B35 =SOM(B4:B34) zet telt hij automatisch netjes op, maar als ik dan klaar ben met heel deze Rij en naar het tabblad ‘Invoertijden’ ga, en vervolgens weer terug naar het tabblad ‘Resultaat’ is de formule weer weg en staat alles weer op nul. Weet iemand waar de fout zit in de VB-code, of is het wel een fout in de code? Ik heb niet zo veel verstand van Visual Basic!

Bekijk bijlage Snipperkaart 08-12-2018 VB .xlsm

Ik werk met Microsoft Office 365 en macOS 10.13.6

Anstof

 

[emields]

bekijk uw macro kleuren vullen eens en probeer te begrijpen wat hij doet.

 

[anstof]

Zoals ik het zie in de code kopieert 'Invoertijden' de cellen B4:Y34 naar de cellen in 'Resultaat' B4:Y34 en volgens mij moeten dit de cellen B4:Y35 zijn.

Sub Kleuren_Vullen()
  Sheets("Invoertijden").Range[COLOR="#FF0000"]("B4:Y34")[/COLOR].Copy
  With Sheets("Resultaat").Range[COLOR="#FF0000"]("B4:Y34")[/COLOR]
    .PasteSpecial xlPasteFormats
    .NumberFormat = "0.00"
    .ClearContents
    .Cells(1).Select
    ar = Sheets("Invoertijden").Cells(1).CurrentRegion
    ar1 = .Parent.Cells(1).CurrentRegion
      For j = 4 To UBound(ar) - 1
        For jj = 2 To UBound(ar, 2)
          If ar(j, jj) <> "" Then ar1(j, jj) = ar(j, jj) * 24
      Next jj
   Next j
   .Parent.Cells(1).CurrentRegion = ar1
  End With
End Su

Anstof

 

[emields]

en wat doet dat 2° deel?

 

[anstof]

Hij kopieert het gebied van het tabblad 'Invoertijden' naar het gebied van 'Resultaat'

 

[anstof]

Bedoel je misschien het tweede deel van de gehele code?

Code:

Sub Kleuren_Vullen()
  Sheets("Invoertijden").Range("B4:Y34").Copy
  With Sheets("Resultaat").Range("B4:Y34")
    .PasteSpecial xlPasteFormats
    .NumberFormat = "0.00"
    .ClearContents
    .Cells(1).Select
    [COLOR="#FF0000"]ar = Sheets("Invoertijden").Cells(1).CurrentRegion
    ar1 = .Parent.Cells(1).CurrentRegion
      For j = 4 To UBound(ar) - 1
        For jj = 2 To UBound(ar, 2)
          If ar(j, jj) <> "" Then ar1(j, jj) = ar(j, jj) * 24
      Next jj
   Next j
   .Parent.Cells(1).CurrentRegion = ar1
  End With
End Sub[/COLOR]
/CODE]

Anstof

 

[HSV]

ar = Sheets("Invoertijden").Cells(1).CurrentRegion
    ar1 = ar
      For j = 4 To UBound(ar)
        For jj = 2 To UBound(ar, 2)
          If ar(j, jj) <> "" Then ar1(j, jj) = ar(j, jj) * 24
      Next jj
   Next j
   .Parent.Cells(1).Resize(35, 25) = ar1
  End With

 

[anstof]

Dank je wel HSV, alles werkt nu precies zoals het zo moeten. Al weet ik nog niet wat het verschil is met:

ar1 = .Parent.Cells(1).CurrentRegion
en
ar1 = ar

Anstof

 

[HSV]

ar1 is nu even groot als ar.

Doordat de regel .clearcontents boven ar1 staat heb je een ander currentregion verkregen.
Rij 35 is immers leeg na de .clearcontents.

Sheets("Invoertijden").Range([COLOR=#0000ff]"B4:Y35").[/COLOR]Copy
  With Sheets("Resultaat").Range([COLOR=#0000ff]"B4:Y35"[/COLOR])
    .PasteSpecial xlPasteFormats
    .NumberFormat = "0.00"
[COLOR=#ff0000]    .ClearContents[/COLOR]
    .Cells(1).Select
    ar = Sheets("Invoertijden").Cells(1).CurrentRegion
    [COLOR=#ff0000]ar1 [/COLOR]= ar

anders geschreven.

Sub Kleuren_Vullen()
With Sheets("Resultaat").Range("B4:Y35")
 Sheets("Invoertijden").Range("B4:Y35").Copy .Parent.Range("B4")
    .NumberFormat = "0.00"
    ar = Sheets("Invoertijden").Cells(1).CurrentRegion
    ar1 = ar
      For j = 4 To UBound(ar)
        For jj = 2 To UBound(ar, 2)
          If ar(j, jj) <> "" Then ar1(j, jj) = ar(j, jj) * 24
      Next jj
   Next j
   .Parent.Cells(1).Resize(35, 25) = ar1
  End With
End Sub

Of:

Sub Kleuren_Vullen()
With Sheets("Resultaat").Range("B4:Y35")
 Sheets("Invoertijden").Range("B4:Y35").Copy .Parent.Range("B4")
  .NumberFormat = "0.00"
  .Value = [if(resultaat!B4:Y35>0,resultaat!B4:Y35*24,"")]
 End With
End Sub

 

[anstof]

Dus de fout zat wel in bereik B4:B34 wat eigenlijk B4:B35 had moeten zijn en dan met aangepaste code.

Dank je wel