bakerman

Maak van namen een dynamisch bereik zodat je namen kan toevoegen of verwijderen zonder dat je steeds het

bereik moet aanpassen in Namen Definiëren.

test_atr.xlsx

Met een streepje VBA is het mogelijk. Nadeel is dat je daadwerkelijk iets moet invullen in elke cel alvorens je kan verdergaan.

Private Sub Worksheet_Change(ByVal Target As Range)
 
  Dim TabOrder As String
  TabOrder = "C2,E4,G2,C4,E2,C6"
  TabOrder = "," & Replace(Replace(TabOrder & "," & Split(TabOrder, ",")(0), "$", ""), " ", "")
  If InStr(TabOrder, "," & Target.Address(0, 0) & ",") Then
    Range(Split(Split(TabOrder, "," & Target.Address(0, 0) & ",")(1), ",")(0)).Select
  End If
 
End Sub

De volgorde kan je wijzigen in TabOrder.

test volgorde niet beveiligde cellen.xlsm

Zet volgende code in de codemodule van Blad1.

Private Sub CmbATR_Change()
    With Range("Tabel1").ListObject
        Range("E7") = Application.Index(.DataBodyRange, _
                Application.Match(CmbATR.Value, .DataBodyRange.Columns(2), 0), 3)
    End With
End Sub

Heb een eenvoudig opzetje gemaakt met wat ik denk dat je bedoelt.

We zoeken steeds naar de waarde in de 1ste rij of 1ste kolom om het juiste adres te bepalen.

Het geeft je in ieder geval de functies die je nodig hebt om jouw bestand aan te passen.

Bekijk het eens en van daaruit kunnen we dan verder.

Johanvd1993.xlsx

De formule op het werkblad evalueert enkel 1 cel. Achter de schermen evalueert UitgebreidFilter de formule voor elke cel

in kolom A (of een andere kolom naargelang de opstelling van de formule). Dus naargelang hoe de formule is opgesteld wordt er gefilterd op Waar of Onwaar.

Op deze manier worden alle overeenkomende regels opgehaald en rechts in de resultaattabel geplaatst.

Alles hangt dus af op welke manier je de formule neerpent.

Deze formule is nodig om het UitgebreidFilter te laten werken.

Je mag dit gerust uit het zicht verplaatsen of de Fontkleur op Wit zetten zodat het niet opvalt.

Verplaats je het echter moet je dit wel nog even aanpassen bij Formules - Namen Beheren - Criteria.

Met een extraatje.

Het bovenste tabelletje geeft je het meest voorkomende getal per kolom met daaronder het aantal keer.

Het onderste tabelletje geeft je de meest voorkomende cijfers uit het ganse bereik met hun aantal keer daaronder.

AdvancedFilterIII.xlsm

Bij data1 in Formules - Namen Beheren verwijder de -1. Dan is je probleem opgelost.

Voor jou uiteraard hetzelfde toegewenst.

Voor de sport een nog snellere methode dan mijn vorige code (2x sneller)

AdvancedFilter.xlsm

Optie 2 lijkt mij het veiligste.

Let wel moest je mijn methode kiezen en je wil de bladnaam wijzigen dan moet je bij

Formules - Namen Beheren deze wijziging ook 2x doen bij het benoemd bereik data

Gegevens rij per rij inlezen vanuit het werkblad en verwerken is de slechtste en traagste methode in VBA.

Zeker als de dataset 4K rijen, en groeiende is.

Ik heb beide codes achter een verschillend werkblad gezet met een dataset van 5K rijen. typ in de gele cellen bv. 8 in en let op het tijdsverschil

om +/- 350 resultaatrijen op te halen.

d_ba.xlsm

Geen loops nodig.

voorbeeldbestand_wb.xlsm

=INDEX(Sheet1!$F$1:$F$5;MATCH(1;($B2=Sheet1!$B$1:$B$5)*($C2=Sheet1!$C$1:$C$5);0))

Opgelet, array formule dus bevestigen met CONTROL-SHIFT-ENTER.

Graag gedaan en bedankt voor de feedback. 👍

Aangezien de volledige padnaam in je kolom M staat.

Getest en werkend op de indeling van het laatst doorgestuurde bestand.

Sub dotch()
Dim Cell As Range, Path As String
With Sheets("Export")
    For Each Cell In .Range("M2:M" & .Cells(.Rows.Count, 13).End(xlUp).Row)
        If Cell.Value <> vbNullString Then
            If Dir(Cell.Value) <> "" Then
                With .Pictures.Insert(Cell.Value)
                    .ShapeRange.LockAspectRatio = msoFalse
                    .Left = Cell.Offset(, 1).Left: .Top = Cell.Offset(, 1).Top
                    .Width = Cell.Offset(, 1).Width: .Height = Cell.Offset(, 1).Height
                End With
            End If
        End If
    Next Cell
End With
End Sub

Heb het getest met een lege cel, bestandsnaam die aanwezig is, bestandsnaam die niet aanwezig is en verschillende extensies.

Werkt feilloos hier.

Zoals de foutmelding al aangeeft schort er iets aan je bestandsnamen. Misschien ongeldige tekens in de bestandsnaam o.i.d..

dj is je blijkbaar vergeten dus spring ik maar even in.

Volgende zou je moeten verder helpen.

Sub dotch()
Dim Cell As Range, Path As String
Path = "C:\#[Data]#\Music Collector\Images\"
With Sheets("Export")
    For Each Cell In .Range("M2:M" & .Cells(.Rows.Count, 13).End(xlUp).Row)
        If Cell.Value <> vbNullString Then
            If Dir(Path & Cell & ".*") <> "" Then
                ext = CreateObject("scripting.filesystemobject").getextensionname(Dir(Path & Cell & ".*"))
                With .Pictures.Insert(Path & Cell & "." & ext)
                    .ShapeRange.LockAspectRatio = msoFalse
                    .Left = Cell.Offset(, 1).Left: .Top = Cell.Offset(, 1).Top
                    .Width = Cell.Offset(, 1).Width: .Height = Cell.Offset(, 1).Height
                End With
            End If
        End If
    Next Cell
End With
End Sub

Sub Insert_Pict1()
    Dim lRow As Long, lLoop As Long
    Dim sShape As Shape
    Dim myarray As Variant
    With Sheets("Export")
        myarray = Application.Transpose(.Range("M2", .Range("M1048576").End(xlUp)).Value)
        If Not IsArray(myarray) Then MsgBox "Geen bestanden geselecteerd.": Exit Sub
        On Error Resume Next
        lRow = 2
        For lLoop = LBound(myarray) To UBound(myarray)
            Set sShape = .Shapes.AddPicture(myarray(lLoop), msoFalse, msoCTrue, _
                .Cells(1, 14).Left + 9, .Cells(lRow, 14).Top + 8, 80, 60)
            lRow = lRow + 1
        Next lLoop
    End With
End Sub

Wat denk je van deze?

zoeken verschillende parameters_wb.xlsx

Het kan ook met een alternatieve formule.

=$B$3 = ""

Je hebt het forum nu al 2X bezocht nadat ik gepost heb.

Is het dan echt zoveel gevraagd om even een berichtje, wat dan ook, achter te laten.

Blijkbaar nog veel te leren over forumetiquette.

Mijn interesse in jouw vraag is nu wel helemaal verdwenen. Suc6 nog met je project

112 keer bekeken en geen gegadigden, dan zal ik de debatten maar openen.

Om te filteren terwijl je typt moet je gebruik maken van een Combobox maar 25000 (of meer) comboboxen op een werkblad lijkt me overkill.

Dus met je gegevensvalidatie lijkt dit me het beste alternatief. Er is wel een stukje VBA voor nodig dus als dit een bezwaar is zit j in de problemen.

Typ het woord (of een deel) dat je zoekt in een cel in kolom B en druk op Enter (of Tab). je Validatielijst is nu gefilterd.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns(2)) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        If Target = vbNullString Then Exit Sub
        sn = Sheet2.Cells(1).CurrentRegion
        With CreateObject("Scripting.Dictionary")
            For j = 1 To UBound(sn)
                If sn(j, 1) Like "*" & Target.Value & "*" Then .Add sn(j, 1), ""
            Next
            Target.Validation.Delete
            Target.Validation.Add xlValidateList, , , Join(.keys, ",")
            Target.Validation.ShowError = False
        End With
    End If
End Sub

categorie selectie test.xlsm

Mijns inziens maak jij een denkfout omdat je zoals jij het voorstelt nogmaals commissie gaat berekenen op reeds verrekende commissie.

De commissie is geen kost als dusdanig (zoals bv. loonkost) maar een méérkost op de verkoopprijs.

Wat jij volgens mij nodig hebt is een kolom waar je al je kosten in samentelt (Aankoop+Vaste kosten+verpakking+Verzending + Loonkost+Vooropgestelde winst)

Daarop bereken je dan de BTW die je bij de som van je kosten telt zodat je de bruto verkoopprijs bekomt. Daarop ga je dan je commissie berekenen die je dan bij

de bruto verkoopprijs telt om zo uiteindelijk bij je netto verkoopprijs te komen. Als je dan later de commissie aftrekt van het ontvangen bedrag is dit eigenlijk

een nul-operatie.

Ik zag ook in je tabel 2X kolommen waarin je commissie berekent?????

Beste Magda,

Mijn commentaar was allerminst naar jouw persoon gericht, maar eerder een beschouwing van hoe het mijns inziens opgelost zou moeten worden.

Ben ook even aan de slag gegaan zoals je zal zien in de bijlage. Je tabblad Inkoop vul je zoals vanouds in. Omdat je data nu als tabel is opgemaakt

worden bij elke nieuwe regel de validatie en formules automatisch meegenomen. Je zal merken dat elk inkooporder standaard op Openstaand staat.

Van zodra je een betaaldatum invoert wordt de status automatisch naar Betaald gewijzigd. Wanneer je nu op tabblad Betalingen een nieuwe regel invoert

wordt in Inkoop gezocht naar de gelijkaardige Omschrijving en indien gevonden wordt de betaaldatum ingevuld, wat weer tot gevolg heeft dat de status naar

Betaald wordt gezet, net zoals je gevraagd hebt. Let er wel op dat je steeds de omschrijving invult alvorens het bedrag in te vullen.Op blad Lijsten staan

alle lijsten voor de datavalidatie. De lijst openstaand genereert door de aanwezige formule elke Omschrijvingen die nog openstaand is. Deze lijst wordt op

Betalingen in de kolom Omschrijving gebruikt zodat je steeds een selectie hebt van nog openstaande inkooporders. Op blad Betalingen staan nog enkele

inkoopordes zonder bedrag om al eens te testen. Heb je nog vragen laat het dan maar weten.

Magdalena.xlsm

Dit stuur je toch niet aan vanuit werkblad inkopen maar vanuit werkblad betalingen.

Een inkooporder dat niet onmiddellijk betaald wordt zet je standaard op Openstaand. Anders op betaald.

Als je nu een betaling invoert ga je de omschrijving zoeken in Inkoop en past de status en datum aan.

Je gaat toch niet eerst alle betalingen invoeren en daarna proberen te onthouden dewelke je hebt ingevoerd om Inkoop aan te passen.

Stuur dit vanuit Betalingen zodat gegevens op Inkoop automatisch aangepast worden en niet andersom.