Op deze website gebruiken we cookies om content en advertenties te personaliseren, om functies voor social media te bieden en om ons websiteverkeer te analyseren. Ook delen we informatie over uw gebruik van onze site met onze partners voor social media, adverteren en analyse. Deze partners kunnen deze gegevens combineren met andere informatie die u aan ze heeft verstrekt of die ze hebben verzameld op basis van uw gebruik van hun services. Meer informatie.

Akkoord

Vraag & Antwoord

Anders (software)

Urenlijst in excel met macro's

DPinguin
7 antwoorden
  • Hallo,

    Op dit moment ben ik bezig met een urenlijst te maken voor 2004 in excel.

    Ik ben al best ver, maar ik heb wat vraagjes over macro's.

    * Hoe kan ik werkbladen kopieren met een macro zodat de naam van het werkblad een nummer verhoogt. Ik heb nu de volgende code:

    [code:1:db6625f481]
    Sub Macro1()
    '
    ' Macro1 Macro
    '
    ' Sneltoets: CTRL+SHIFT+L
    '
    Sheets("4").Select
    Sheets("4").Copy After:=Sheets(55)
    End Sub
    [/code:1:db6625f481]

    Deze code kopieert het werkblad wel, maar de naam van het blad wordt dan bijvoorbeeld 4 (2), 5 (2) enz… Ik kopieer deze macro een aantal keren achter elkaar en voer hem dan vervolgens uit. Computer is dan aardig flink aan het rekenen, maar het gaat wel automatisch.

    De sheets stellen de weken van het jaar dus voor. Dus in 2004 53 weken.
    Ik wil week 1 52x kopiëren zodat ik 53 weken heb.

    * Verder heb ik gebruik ik 2 andere excelbestanden. Eentje voor de klantcodes en de andere voor aktiviteitcodes. De gegevens worden bij het kopieren van een werkblad bijgewerkt. Dat kost zee-en van tijd. Kan ik dat uitschakelen zodat het kopiëren sneller gaat.

    * Kan ik ook die gegevens (met name klantenlijst) uit het excelbestand verwijderen, want ik wil het bestand wellicht delen met andere mensen.

    Hopelijk kan iemand me helpen. Verder zit ik eraan te denken de urenlijst online te zetten. Ik heb al 'n afschrijvingsstaat, dus als iemand interesse heeft kan me mailen.
  • Hallo, met het copieren kan ik je wel helpen.
    Ik ga ervanuit dat je 1 blad heb en dat deze ook nog eens 1 heet. Anders moet je het een en ander maar even wijzigen in de code:

    [code:1:f7c8e6835b]For i = 1 To 52
    Sheets(i).Select
    Sheets(i).Copy after:=Sheets(i)
    Sheets(i + 1).Name = i + 1
    Next i[/code:1:f7c8e6835b]

    Dit is eigenlijk alles. For en next zorgen ervoor dat het copieren 52x gedaan worden.

    Sheets(i).Copy after:=Sheets(i) zorgt ervoor dat het geselecteerde blad gekopieerd wordt en achter het geselecteerde blad geplaatst wordt.
    Sheets(i + 1).Name = i + 1 zorgt ervoor dat het blad een nummer krijgt die 1 hoger is.

    Groeten, Wouter
  • Voor uw eerste vraag:
    [code:1:6c3b29b579]
    Public Sub CopyActiveSheet()
    Dim shtHighestNumber As Integer

    shtHighestNumber = CStr(HighestSheetNumber) + 1
    ActiveSheet.Copy After:=Worksheets(Worksheets.Count)

    ActiveSheet.Name = shtHighestNumber
    End Sub
    '

    Public Function HighestSheetNumber() As Integer
    Dim sht As Worksheet
    Dim iSheetNumber As Integer

    HighestSheetNumber = 0

    For Each sht In ActiveWorkbook.Worksheets

    On Error Resume Next
    iSheetNumber = CInt(ActiveSheet.Name)

    If (Err.Number = 0) And (iSheetNumber > HighestSheetNumber) Then
    HighestSheetNumber = iSheetNumber
    End If

    Next sht

    End Function
    [/code:1:6c3b29b579]
  • Oeps, een klein foutje op lijn 4:
    [code:1:6a6e2a45d0]
    shtHighestNumber = CStr(HighestSheetNumber + 1)
    [/code:1:6a6e2a45d0]
    Wanneer uw actieve werkblad (dat wordt gekopiëerd) geen numerieke naam heeft, zal deze functie zelf aan het nieuwe werkblad een numerieke waarde toekennen die één hoger ligt dan de hoogstgenummerde werkbladnaam in uw werkboek.

    U kunt deze procedure desgewenst in een lus plaatsen, ofwel toekennen aan een sneltoets.
  • Voor uw tweede vraag, in verband met het 'versnellen' van het uitvoeren, kunt u de volgende code plaatsen vóór het uitvoeren:
    [code:1:a19780d66c]
    Application.ScreenUpdating = False
    [/code:1:a19780d66c]
    … en ná de uitvoerende code:
    [code:1:a19780d66c]
    Application.ScreenUpdating = True
    [/code:1:a19780d66c]
    U zal zien dat het een hemelsbreed verschil geeft qua uitvoeringstijd.
  • Bedankt voor de tips.

    Sorry, voor maar late reactie. Helaas kom ik er nog niet helemaal uit.

    De code van E. Cle werkt wel. Alleen werd de sheet 1 keer gekopieerd. Dus ik heb de 52 xcode gekopieerd, maar toen krijg ik de melding dat een variabele ongeldig was. Het lukt me niet om in een korte tijd zelf die for-lus op te stellen in combinatie met de andere code. Urenlijst moet vandaag helaas al af zijn.

    De code van E. Clde bestaat uit 2 functies toch? Of is Public Function HighestSheetNumber() As Integer een onderdeel van CopyActiveSheet?

    [code:1:01a0e400fd]
    Application.ScreenUpdating = False


    Public Sub CopyActiveSheet()
    Dim shtHighestNumber As Integer

    shtHighestNumber = CStr(HighestSheetNumber + 1)
    ActiveSheet.Copy After:=Worksheets(Worksheets.Count)

    ActiveSheet.Name = shtHighestNumber
    End Sub
    '

    Public Function HighestSheetNumber() As Integer
    Dim sht As Worksheet
    Dim iSheetNumber As Integer

    HighestSheetNumber = 0

    For Each sht In ActiveWorkbook.Worksheets

    On Error Resume Next
    iSheetNumber = CInt(ActiveSheet.Name)

    If (Err.Number = 0) And (iSheetNumber > HighestSheetNumber) Then
    HighestSheetNumber = iSheetNumber
    End If

    Next sht

    End Function



    Application.ScreenUpdating = True

    [/code:1:01a0e400fd]


    Doe ik iets verkeerd?

    Klopt die apastrofe trouewns na End Sub? Dat zijn toch opmerkingtekens?

    Hopelijk kan iemand me ff helpen…
  • Voilà, hier heb je het gehele programma:
    [code:1:aa6463709a]
    Option Explicit
    '

    Public Sub Copy52()
    Dim i As Integer

    Application.ScreenUpdating = False

    For i = 1 To 52
    CopyActiveSheet
    Next i

    Application.ScreenUpdating = True
    End Sub
    '

    Private Sub CopyActiveSheet()
    Dim strHighestNumber As String

    strHighestNumber = CStr(HighestSheetNumber + 1)
    ActiveSheet.Copy After:=Worksheets(Worksheets.Count)

    ActiveSheet.Name = strHighestNumber
    End Sub
    '

    Private Function HighestSheetNumber() As Integer
    Dim sht As Worksheet
    Dim iSheetNumber As Integer

    HighestSheetNumber = 0

    For Each sht In ActiveWorkbook.Worksheets

    On Error Resume Next
    iSheetNumber = CInt(ActiveSheet.Name)

    If (Err.Number = 0) And (iSheetNumber > HighestSheetNumber) Then
    HighestSheetNumber = iSheetNumber
    End If

    Next sht

    End Function
    [/code:1:aa6463709a]
    Creëer een lege module, kopieer deze code daarin, en voer uit…

Beantwoord deze vraag

Dit is een gearchiveerde pagina. Antwoorden is niet meer mogelijk.