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

Compileerfout: procedure is te groot

Status
Niet open voor verdere reacties.
H

halloikke

Gebruiker
Lid geworden
11 feb 2015
Berichten
25
Hallo allemaal,

Ik heb een excelbestand waarin uren opgesplitst worden naar de juiste componenten en vanuit daar omgeschreven worden naar een importformat.

In principe werkt mijn code wel, echter is deze denk ik te groot geworden. Kan iemand mij hiermee helpen? wellicht de code op een kortere manier opstellen?
 

Bijlagen

  • voorbeeldbestand - kopie.xlsm
    448,7 KB · Weergaven: 35
Niet getest, maar kijk eens hier naar voor de principes die ik heb gebruikt.
 

Bijlagen

  • voorbeeldbestand - kopie (1).xlsm
    426,9 KB · Weergaven: 29
Maak voor het vullen van al die variabelen gebruik van arrays en vul die in een loop.
Bijvoorbeeld:
Code: 
Dim strcodeLooncomp(1 To 105) As Variant
For i = 1 To 105
    strcodeLooncomp(i) = ActiveSheet.Cells(i + 3, 5).Value
Next i
 
Alles dmv array's

Code: 
Sub VenA()
ar = Sheets("Omzetting naar overuren per dag").Cells(1).CurrentRegion
ReDim ar1(8, 0)
  For j = 5 To UBound(ar)
    If ar(j, 1) <> 0 Then
      For jj = 5 To UBound(ar, 2)
        If ar(j, jj) <> 0 Then
          t = UBound(ar1, 2)
          ar1(0, t) = ar(j, 4)
          ar1(1, t) = ar(j, 2)
          ar1(2, t) = ar(j, 3)
          ar1(3, t) = "Nunhems Netherlands BV"
          'ar1(4, t) = ar(j, 1)
          ar1(5, t) = ar(4, jj)
          ar1(6, t) = ar(3, jj)
          ar1(7, t) = CDate(ar(2, jj))
          ar1(8, t) = ar(j, jj)
          ReDim Preserve ar1(8, t + 1)
        End If
      Next jj
    End If
  Next j
  With Sheets("Uitvoer")
    .Cells(1).CurrentRegion.Offset(1).ClearContents
    .Cells(2, 1).Resize(t, 9) = Application.Transpose(ar1)
  End With
End Sub
 
Dat scheelt een paar regeltjes ;)
 
VenA zei:
Alles dmv array's

Code: 
Sub VenA()
ar = Sheets("Omzetting naar overuren per dag").Cells(1).CurrentRegion
ReDim ar1(8, 0)
  For j = 5 To UBound(ar)
    If ar(j, 1) <> 0 Then
      For jj = 5 To UBound(ar, 2)
        If ar(j, jj) <> 0 Then
          t = UBound(ar1, 2)
          ar1(0, t) = ar(j, 4)
          ar1(1, t) = ar(j, 2)
          ar1(2, t) = ar(j, 3)
          ar1(3, t) = "Nunhems Netherlands BV"
          'ar1(4, t) = ar(j, 1)
          ar1(5, t) = ar(4, jj)
          ar1(6, t) = ar(3, jj)
          ar1(7, t) = CDate(ar(2, jj))
          ar1(8, t) = ar(j, jj)
          ReDim Preserve ar1(8, t + 1)
        End If
      Next jj
    End If
  Next j
  With Sheets("Uitvoer")
    .Cells(1).CurrentRegion.Offset(1).ClearContents
    .Cells(2, 1).Resize(t, 9) = Application.Transpose(ar1)
  End With
End Sub
Klik om te vergroten...

Bedankt voor het snelle antwoord. Echter heb ik nog twee vragen:

1: hij neemt nu de laatste waarde niet mee? (bij werknemer 35 op 15-06)

2: kun je er nog voor zorgen dat de beginregel waar op weggeschreven wordt nummer 4 is (zodat er dus 2 witregels tussendoor overblijven)?
 
Waarom lege regels? Even aanpassen

Code: 
.Cells(1).CurrentRegion.Offset([COLOR="#FF0000"]3[/COLOR]).ClearContents
    .Cells([COLOR="#FF0000"]4[/COLOR], 1).Resize(t [COLOR="#FF0000"]+ 1[/COLOR], 9) = Application.Transpose(ar1)
 
Top bedankt!!

De twee lege regels zijn nodig omdat de software die het gaat inlezen om de een of andere vage reden pas op regel 4 begint met inlezen.....
 
Volgens mij gaat het met de datums nog niet goed.

Code: 
ar1(7, t) = CDate(ar(2, jj))
even aanpassen in

Code: 
ar1(7, t) = Format(ar(2, jj), "mm-dd-yyyy")

Doet het bij mij beter.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan