bakerman

Ga naar Bestand - Opties. Ga naar Uitgebreid - Weergave voor dit werkblad. Optie Werkblad weergeven van Rechts naar Links uitvinken.

Zo iets dan ? Private Sub Workbook_Open() For Each huidigecel In Range("G1:G5") If (Val(huidigecel.Value) = 0 And IsNumeric(huidigecel.Value)) Then huidigecel.Value = "" End If Next With Range("G3") .FormulaR1C1 = "=SUM(RC[-2]+RC[-1])" .Resize(3).FillDown End With End Sub

Logisch, in een cel heb je ofwel manuele invoer of een formule. Het is het één of het ander, beide kan niet. Als je met zulke kunstgrepen wil beginnen zou ik toch maar eens nadenken over het ontwerp van je werkblad want daar schort dan wel iets aan. Post een voorbeeldbestand zodat we eens kunnen bekijken welke aanpassingen mogelijk zijn.

Private Sub Workbook_Open() Sheets("Nieuwe planning").Range("F5:J109").SpecialCells(xlCellTypeConstants).ClearContents End Sub Bovenstaande volstaat normaal. Staan er in dat bereik enkel formules of ook cellen met alleen een waarde in ? Als het enkel formules zijn is het normaal dat je hierop een foutmelding krijgt aangezien er geen cellen te vinden zijn.

Sub SendMail_Click() Fname = "Kopie_Uurstaat" Application.CopyObjectsWithCells = False Sheets("uren").Copy Application.CopyObjectsWithCells = True With ActiveWorkbook .Sheets(1).Protect "JTvD" .SaveAs ThisWorkbook.Path & "\" & Fname, 51 .ChangeFileAccess xlReadOnly .Close True End With With CreateObject("outlook.application").createitem(0) .to = "Joep@hetnet.nl" .Subject = "Uren" .body = "In bijlage de gevraagde uurstaat." & vbLf & vbLf & "Groeten JTvD" .attachments.Add ThisWorkbook.Path & "\" & Fname & ".xlsx" .display End With Kill ThisWorkbook.Path & "\" & Fname & ".xlsx" End Sub

Heb je mijn voorbeeldbestand bekeken waar er code staan en waar niet ?

Voor de zekerheid maar een bestandje toegevoegd. Percentage_ba.xlsx

De oorzaak was vrij eenvoudig (de oplossing ook ) Je hebt een ActiveX-knop gebruikt om de macro te starten. Daardoor komt de code terecht in de bladmodule van Uren werkblad. Bij het maken van een kopie van het werkblad wordt deze code echter ook meegenomen. Als je dan het nieuwe bestand probeert op te slaan als bestand zonder macro's (xlsx) krijg je een foutmelding. Oplossing: Gebruik een knop uit de FormButtons-collectie en verhuis de code naar een standaardmodule zodat dit probleem zich niet voordoet. Ik heb nog 2 lijnen aan de code toegevoegd zodat de knop niet meer in het nieuwe bestand staat. Sub SendMail_Click() Fname = "Kopie_Uurstaat" Application.CopyObjectsWithCells = False Sheets("uren").Copy Application.CopyObjectsWithCells = True With ActiveWorkbook .SaveAs ThisWorkbook.Path & "\" & Fname, 51 .Close False End With With CreateObject("outlook.application").createitem(0) .to = "Joep@hetnet.nl" .Subject = "Uren" .body = "In bijlage de gevraagde uurstaat." & vbLf & vbLf & "Groeten JTvD" .attachments.Add ThisWorkbook.Path & "\" & Fname & ".xlsx" .display End With Kill ThisWorkbook.Path & "\" & Fname & ".xlsx" End Sub Urentest.xlsm

De correcte manier om een percentageverschil te berekenen is (nieuwe waarde - oude waarde)/oude waarde Je zal dan zien dat je bij 2018 > 2019 op de Te betalen rij een negatief percentage krijgt, wat correct is aangezien er een daling is.

Wil je het werkblad als bijlage versturen zal deze het beter doen. Sub SendSheet() Fname = "Kopie_Uurstaat" Sheets("uren").Copy With ActiveWorkbook .SaveAs ThisWorkbook.Path & "\" & Fname, 51 .Close False End With With CreateObject("outlook.application").createitem(0) .to = "hier het emailadres" .Subject = "hier het onderwerp of celverwijzing" .body = "In bijlage de gevraagde uurstaat." & vbLf & vbLf & "Groeten JTvD" .attachments.Add ThisWorkbook.Path & "\" & Fname & ".xlsx" .display End With Kill ThisWorkbook.Path & "\" & Fname & ".xlsx" End Sub

Laten we hier al eens mee beginnen. Door het jaartal in G1 te wijzigen kan je de verschillende resultaten bekomen. Ludo.xlsx

En wat ook belangrijk is welke foutmelding je krijgt.

En nog eentje. Book1_ba.xlsx

Kijk eens of dit je verder helpt. Excel functies.xlsx

@dotchiejack Er zit een fout in je code. je had staan For k = 1 to 3 , maar dan wordt de Achternaam niet meegenomen in je nieuwe ListBoxlijst dus .. Private Sub T_09_Change() On Error GoTo oops lijst = [leden_tbl].Value arg = 0 For i = 1 To UBound(lijst) If InStr(1, lijst(i, 2), T_09, vbTextCompare) > 0 Then arg = arg + 1 End If Next i ReDim nwlijst(arg - 1, 3) arg = 0 For i = 1 To UBound(lijst) If InStr(1, lijst(i, 2), T_09, vbTextCompare) > 0 Then For k = 1 To 4 nwlijst(arg, k - 1) = lijst(i, k) Next k arg = arg + 1 End If Next LB_00.List = nwlijst oops: End Sub

Ik heb je tot hiertoe nog niet weten zeggen welke informatie je eigenlijk op je verzamelblad wil zien ??

Heb je al eens geprobeerd een herstel van je office applicatie te doen ? Als dit niet helpt is een nieuwe installatie waarschijnlijk aanbevolen.

Een voorbeeldbestandje zou ons al enorm voorthelpen alsook een duidelijkere uitleg aangaande om welke kolom het gaat. In welke cel staat je loon, hoeveel bedraagt de RSZ, enz....

Met de juiste vertaling. MLyc.xlsx

Kijk eens of deze doet wat jij wil. =ROUNDUP(SUMPRODUCT(($A$2:$A$500=$A2)*($C$2:$C$500=$C2)*($D$2:$D$500=$D2)*1/COUNTIF($B$2:$B$500;$B$2:$B$500&""));0) Aangezien Somproduct een array-formule is die veel rekenkracht vergt heb ik ervoor gekozen het bereik te beperken to( rij 500 ipv volledige kolommen. Wijzig dit naar een getal dat niet te groot is maar waarvan jij denkt dat je het niet zal overschrijden. PS: Je moet de formule nog wel even vertalen want werk momenteel met een engelstalige XL-versie.

Worksheet_Change-event reageert niet op een wijziging van de waarde door een formule. Wijzig daarom de broncel naar B5, dewelke de verandering start. Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$5" Then If Target = vbNullString Then Exit Sub If Target < 0 Then Exit Sub Application.ScreenUpdating = False Range("F96:F98").ClearContents SolverReset SolverOK Range("$F$101"), 2, , Range("$F$96:$F$98"), 1 SolverAdd Range("$F$96:$F$98"), 4 SolverSolve True Application.ScreenUpdating = True End If End Sub

In de bladmodule van Blad1. Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Columns(8)) Is Nothing Then If LCase(Target.Value) = "geselecteerd" Then With Sheet2 .ListObjects("TBL_Kandidaten").ListRows.Add .Cells(.ListObjects("TBL_Kandidaten").ListRows.Count + 4, 2).Resize(, 6).Value = Cells(Target.Row, 1).Resize(, 6).Value End With End If End If End Sub PS: Ik hoop dat het niet jouw echt telefoonnummer en emailadres is in het voorbeeldbestand.

Bedankt voor de feedback. Je kan code opnemen met de macrorecorder om een gevoel te krijgen van de gebruikte syntax maar in een later stadium ga je zelf alles vanaf 0 schrijven.

Nog eentje om te testen. =ALS(EN(OF(NIET(ISFOUT(JAAR(C3)));C3="Optie");C3<>"");1;0)

=ALS(EN(NIET(ISFOUT(JAAR(B3)));B3<>"");1;0) PS: Een formule wordt slechts herberekend als de wijziging wordt bevestigd met Enter.