bakerman

Jij hebt blijkbaar wel de gewoonte om vragen onbeantwoord te laten openstaan. Misschien kan deze ook ineens afwerken. https://www.pc-helpforum.be/topic/74639-berekenen-van-percentage/

Ik denk dat we voldoende hebben aangetoond dat dit niet mogelijk zal zijn met gewone formules. Daarom een stukje VBA. Door de waarde in cel C2 te wijzigen worden de getallen in A5 en A10 herberekend. controle.xlsm

Er stonden wat foutjes in de formule van emiel maar de basis heeft hij wel gelegd en deze doet wat jij verwacht. =ALS(A1=1;'Q:\MANUFACTURING\Projecturen\X---KOST BEREKENING\info\2\[waardes 1 .xlsx]1'!$A$1;ALS(A1=2;'Q:\MANUFACTURING\Projecturen\X---KOST BEREKENING\info\2\[waardes 1 .xlsx]2'!$A$1;ALS(A1=3;'Q:\MANUFACTURING\Projecturen\X---KOST BEREKENING\info\2\[waardes 1 .xlsx]3'!$A$1;""))) De formule uit je andere vraag werkt niet met gesloten bestanden. Je zal deze dus enkel kunnen gebruiken als je waardes-bestanden geopend zijn. Indirect werkt niet met gesloten bestanden.

In de bijlage 2 formules die in één oogopslag de huidige rekeningstand weergeven zonder dat je telkens naar de laatste cel hoeft te scrollen. ianlaw_ba.xlsx

Voor de lol, Array approach. Sub baker() Sheets("Dagoverzicht").Range("A7").CurrentRegion.Offset(1).Clear Dim arr: ReDim arr(5, 1) For ws = 2 To Sheets.Count For i = Sheets(ws).Cells(Rows.Count, 1).End(xlUp).Row To 4 Step -1 If Sheets(ws).Cells(i, 4) = Date Then For j = 0 To 4 arr(j, UBound(arr, 2) - 1) = Application.Index(Sheets(ws).Rows(i), 0, j + 1) Next ReDim Preserve arr(5, UBound(arr, 2) + 1) End If Next Next ws Sheets("Dagoverzicht").Range("A8").Resize(UBound(arr, 2), 5) = Application.Transpose(arr) End Sub

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.