bakerman

BertP, Heb het momenteel razend druk op het werk dus antwoorden lopen vertraging op. Mijn excuses hiervoor. In het bestand een voorlopige aangepaste formule. Test eens of deze onder alle omstandigheden de juiste oplossing geeft. BertP_Drukverlies berekening GAS_baII.xlsx

Als ik het goed begrijp ? PS: Heb even formule in E23 gewijzigd omdat IFS bij mij niet werkt, maar deze kan je terug vervangen door de originele formule. BertP_Drukverlies berekening GAS_ba.xlsx

Probeer het eens met deze. Het resultaat komt op het 2de werkblad. Sub tst2() t = Timer sn = Sheet1.Cells(1).CurrentRegion.Offset(1).Value Set dic = CreateObject("scripting.dictionary") For i = 1 To UBound(sn) If Not dic.exists(sn(i, 1)) Then dic.Add sn(i, 1), Empty Next k = 0 For Each Key In dic.keys For i = 1 To UBound(sn) If (sn(i, 1) = Key) * (sn(i, 5) <> vbNullString) Then If k = 0 Then ReDim arr(0 To k) Else ReDim Preserve arr(0 To k) End If arr(k) = sn(i, 5) k = k + 1 End If Next Select Case k Case 0 dic.Item(Key) = "Ontbrekend" Case 1 dic.Item(Key) = arr(0): k = 0 Case Is > 1 max = Application.Mode(arr) If Not IsError(max) Then dic.Item(Key) = max Else dic.Item(Key) = Application.Min(arr): k = 0 End If Erase arr: k = 0 End Select Next For i = 1 To UBound(sn) If sn(i, 5) = vbNullString Then sn(i, 5) = dic.Item(sn(i, 1)) Next With Sheet2 .Cells(1).CurrentRegion.Offset(1).ClearContents .Cells(2, 1).Resize(UBound(sn), 5) = sn End With MsgBox Timer - t End Sub De formules op het 1ste blad zijn enkel ter controle dus die mogen weg. Bello2020_ontbrekende bouwjaren.xlsm

Probeer het eens met deze. Drukverlies berekening GAS_ba.xlsx

Deze doet wat moet maar weet niet hoe de code zich zal houden bij 10K rijen. Test eens en laat maar iets weten. Sub tst() sn = Cells(1).CurrentRegion.Offset(1).Value noyear = 5000 With CreateObject("scripting.dictionary") For i = 1 To UBound(sn) If Not .exists(sn(i, 1)) Then .Add sn(i, 1), IIf(IsNumeric(sn(i, 5)), sn(i, 5), noyear) Else If (IsNumeric(sn(i, 5))) * (IsNumeric(.Item(sn(i, 1)))) Then .Item(sn(i, 1)) = Application.Min(sn(i, 5), .Item(sn(i, 1))) End If End If Next For i = 1 To UBound(sn) If sn(i, 5) = vbNullString Then sn(i, 5) = IIf(.Item(sn(i, 1)) <> 5000, .Item(sn(i, 1)), "Ontbrekend") Next Cells(2, 1).Resize(UBound(sn), 5) = sn End With End Sub

Kan je misschien ook uitleggen WAT er nu eigenlijk gebeurd ??????

Private Sub Worksheet_Change(ByVal Target As Range) If (Target.Column = 1) * (Target.Value <> vbNullString) Then Sheets("HNW343239").Copy , Sheets(Sheets.Count) Sheets(Sheets.Count).Name = "HNW" & Target.Value End If If Target.Column = 8 Then Application.EnableEvents = False Newvalue = Target.Value Application.Undo Oldvalue = Target.Value If InStr(1, Oldvalue, Newvalue, vbTextCompare) > 0 Then Target.Value = Oldvalue: GoTo Earlyexit End If If Oldvalue = "" Then Target.Value = Newvalue Else Target.Value = Oldvalue & ", " & Newvalue End If End If Earlyexit: Application.EnableEvents = True End Sub

Private Sub Worksheet_Change(ByVal Target As Range) If (Target.Column = 1) * (Target.Value <> vbNullString) Then Sheets("HNW343239").Copy , Sheets(Sheets.Count) Sheets(Sheets.Count).Name = "HNW" & Target.Value End If End Sub

Philiep, Is het dan niet handiger volgende formule te gebruiken zodat je de extra cellen voor huidige datum niet nodig hebt ? =DATUM(JAAR(NU())-$D$3;MAAND(NU())-$E$3;DAG(NU())-$F$3)

Goed gedaan. 👍 Bedankt voor de feedback.

Korte versie. Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("C1")) Is Nothing Then Range("A2:A11").EntireRow.Hidden = Not (Application.Weekday(Target) = 3) End If End Sub

Dat is de naam van je tabel die op blad documents staat. Geef je deze naam zelf of wordt deze automatisch gegeven ? Als deze naam automatisch meekomt zal je je tabel wel telkens moeten hernoemen naar een zelfgekozen naam gelijkaardig aan diegene die je in de formules gebruikt.

Omdat je vraagstelling vrij summier is toch maar een poging tot ... Bello2020_Formulier.xlsx

Ik hoop voor jou dat iemand mijn ongelijk kan bewijzen maar voor zover ik weet is dit helaas niet mogelijk.

Wijzig de waarde in B5 en de rest wordt aangevuld. Validatie.xlsx

Toch maar even het bestandje met de formule erin. K-rin_als functie.xlsx

=IF(F$13>$R$15;0;IF(AND(F$13>0;F$13<$R$15);$R$15-F$13;IF(F$13<0;$R$15+(F$13*-1)))) Je moet ze nog wel even vertalen.

Deze met dynamische gegevensvalidatie in kolom B zodat er geen schrijffouten kunnen voorkomen. JTvD_invullen _namen_ba.xlsm

Deze met error-trapping in geval er voor een bepaalde shift geen namen geselecteerd zijn in werkblad Validatie. Sub test() wknum = Application.InputBox("Geef het weeknummer op.", "Weeknummer", , , , , , 1) numcol = Cells(2, 1).CurrentRegion.Columns.Count If wknum <> vbNullString Then wRow = Application.Match(wknum, Columns(1), 0) If Not IsError(wknum) Then For j = 3 To numcol myGroup = Cells(2, j).Value If myGroup = "" Then Exit Sub x = Filter(Evaluate("transpose(if(Validatie!b2:b10000=""" & myGroup & """,Validatie!a2:a10000))"), False, 0) If UBound(x) = -1 Then GoTo gonext For WK = wRow To wRow + 28 Step 7 Cells(WK, j).Resize(UBound(x) + 1, 1).Value = Application.Transpose(x) Next WK gonext: Next End If End Sub

Op blad Validatie zet je alle namen onder elkaar in kolom A. In kolom B zet je de shift waarin ze die week zullen werken. Klik daarna op Blad1 op de knop en vul het gewenste weeknummer in. Sub test() wknum = Application.InputBox("Geef het weeknummer op.", "Weeknummer", , , , , , 1) numcol = Cells(2, 1).CurrentRegion.Columns.Count If wknum <> vbNullString Then wRow = Application.Match(wknum, Columns(1), 0) If Not IsError(wknum) Then For j = 3 To numcol myGroup = Cells(2, j).Value If myGroup = "" Then Exit Sub x = Filter(Evaluate("transpose(if(Validatie!b2:b10000=""" & myGroup & """,Validatie!a2:a10000))"), False, 0) For WK = wRow To wRow + 28 Step 7 Cells(WK, j).Resize(UBound(x) + 1, 1).Value = Application.Transpose(x) Next WK Next End If End Sub auto invullen namen_ba.xlsm

Bedankt voor de feedback en graag gedaan.

Je kan dit bereiken door gebruik te maken van zogenaamde 3D formules. Ik heb een bestandje toegevoegd zodat je kan zien wat de bedoeling is. Wil je echter een oplossing op maat van jouw bestand zal je een voorbeeld moeten posten zodat we je layout kunnen bekijken. Excel-kenner.xlsx

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.