• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Formules verticaal zoeken + als ?

Status
Niet open voor verdere reacties.
Dit is inderdaad al een stuk van de oplossing.

Nu zou ik ook nog willen dat excel automatisch de maat invult (bv: xs s m l) in de blauwe vakjes, aan de hand van een formule (waarom: in de volledige database staan duizenden artikelen, en bij schoenen bv staat 36 37 38 39 40 41, enz, er zijn wel nooit als 6 verschillende velden per benaming "in het voorbeeld: zwarte strik broek")

het is me gelukt met een formule kijk cel F32, via die weg wil ik alle "blauwe cellen" laten invullen met de gegevens uit kolom "AG" uit de database

thx alvast
 
Dus het kunnen er soms meer en soms minder zijn dan 6 (afhankelijk van de gebruikte maateenheid)
Soms is het dus XS, S, enz en soms schoenmaten 36, 37, enz

Hoe moet je excel laten begrijpen dat als XL niet voorkomt voor een artikel dat dit wel in de cel wordt geplaatst?
Hoe moet je excel laten weten bij welke schoenmaat het moet beginnen?

Ik begrijp wel wat je wilt maar het kan volgens mij niet!
 
Ik heb als verduidelijking de database een beetje uitgebreid.

Wat ik juist wil bereiken is het volgende:
Stap 1: ik plaats zelf een foto + in cel E3 vul ik de "artikelnaam" in (handmatig)
Stap 2: Via verticaal zoeken krijg ik de prijs in cel H35 (werkt !)
Stap 3: Via "een formule" wil ik nu de 6 lege blauwe vakken (cellen: F31/F32/F33 H31/H32/H33 onder de foto, automatisch laten invullen, met de "waarde/inhoud" van kolom "AG" (dit kunnen max 6 regels zijn, dus met 6 blauwe cellen kom ik toe)
Ik wil een formule gebruiken, of een macro, die eerst de artikelnaam vergelijkt, en nadien elk verschillend voorkomende inhoud van cel AG plaatst in bovenvermeldde cellen (F31,F32, enz)

Ik weet dat het niet simpel is, maar denk wel dat dit mogelijk moet zijn met excel :)

in bijlage extra voorbeeldBekijk bijlage catalogusVoorbeeld.xlsx
 
Test het maar eens na het invullen van cel E3.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, firstaddress As String, i As Long, beschikbaar
Application.EnableEvents = False
Range("F31:F33,H31:H33") = 0
If Target.Address = "$E$3" And Target <> "" Then
With Sheets("database").Columns(4)
  Set c = .Find(Target.Value)
    If Not c Is Nothing Then
     firstaddress = c.Address
      Do
         If c.Offset(, 2) > 0 Then beschikbaar = beschikbaar & "," & c.Offset(, 29).Value
         Set c = .FindNext(c)
      Loop While Not c Is Nothing And firstaddress <> c.Address
    End If
      If beschikbaar <> "" Then
          For i = 1 To UBound(Split(beschikbaar, ","))
             Cells(i + IIf(i < 4, 30, 27), IIf(i < 4, 6, 8)) = Split(beschikbaar, ",")(i)
          Next i
      End If
  End With
End If
Application.EnableEvents = True
End Sub

Of beter:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, firstaddress As String, y As Long, beschikbaar
Application.EnableEvents = False
If Target.Address = "$E$3" Then
 Range("F31:F33,H31:H33") = 0
 If Target <> "" Then
    With Sheets("database").Columns(4)
     Set c = .Find(Target.Value)
       If Not c Is Nothing Then
        firstaddress = c.Address
         Do
            If c.Offset(, 2) > 0 Then
               y = y + 1
               Cells(y + IIf(y < 4, 30, 27), IIf(y < 4, 6, 8)) = c.Offset(, 29)
            End If
            Set c = .FindNext(c)
         Loop While Not c Is Nothing And firstaddress <> c.Address
       End If
     End With
 End If
End If
Application.EnableEvents = True
End Sub
 
Laatst bewerkt:
hey Harry,

thx thx thx voor de hulp, je blijft de persoon die de oplossingen steeds tot een goed eind brengt, waarvoor dank :thumb::thumb:

Om niet teveel in circkels te draaien, ben ik alles aan klaar maken, om straks te posten, zodoende we geen onnodig werk verrichten

Dus even geduld, ik kom straks terug met incl voorbeeldbestandjes

tot hoors, en nogmaals bedankt

Tom
 
harry,

Hier ben ik dan, en ga stap voor stap proberen uit te leggen, zodoende we elkaar zo goed mogelijk begrijpen.
* we werken uit 2 verschillende werkmappen, "Stockbeheer2017.xlsm" (heb in bijlage stockbeheerTEST aangemaakt) en map "Catalogus.xlsm"
* Werkmap catalogus
* BasisXlt is het tabblad dat steeds bijgevoegd moet worden, steeds geplaatst op achter het laatste tabblad
* de naam van het bijgevoegde tabblad, zou de datum van die dag moeten worden
* Wijzelf voegen dan de foto's bij, en typen de "artikelnaam" (excate schrijfwijze!)
* als alle cellen die HANDMATIG moeten ingevuld worden (E2 - E36 - E70 - R2 - R36 -R70) wil ik via de knop "gegevens aanvullen" de juiste data uit de werkmap "Stockbeheer2017" laten invullen
* In de cellen (ik spreek nu over foto 1) F30- F31 - F32 - I30 - I31 - I32) wil ik de inhoud van de cellen uit stockbeheer2017 kolom "MAAT" (ongeacht wat hier staat, bv S - M - BL - 38 - enz)
* In de cellen G30 - G31 - G32 -J30 - J31 - J32 wil ik het "getal" uit de kolom van stockbeheer2017 "STOCK", en deze data zou mee moeten veranderen, als de data veranderd in STocKBEHEER
* Hierboven beschreven scenario, moet dan herhalen voor en tot foto 6

Ik denk dat ik niets vergeten ben, en zodoende we in 1 keer weten, waar ik naartoe wil

Hopelijk begrijp je me een beetje

Alvast bedankt, om dit eens te bekijken

Voorbeelden in bijlage

Tom

Bekijk bijlage Catalogus.xlsxBekijk bijlage StockBeheer2017TEST.xlsm

ps: ben nog vergeten dat ook de "verkoopprijs" moet ingevuld worden
 
Laatst bewerkt:
Even mijn visie, en niet denken dat ik je te laag inschat.
Jullie werken met drie mensen aan het bestand.

Wat moet je ermee? (aantal bladen met verwijzingen).
Wat als er iets gaat veranderden in het bestand.
Kan je het onderhouden? (codes aanpassen).

Als er later iets fout gaat heb je problemen die een ander op moet lossen, maar die door complexiteit niet weet waar te beginnen.

Test het eerst maar eens, en dan maar kijken wat er nog aan schort.
In een standaard module in werkboek catalogus.

Code: 
Sub hsv()
Dim c As Range, cl As Range, firstaddress As String, y As Long
Application.ScreenUpdating = False
Range("F30:G32,F64:G66,F98:G100,I30:J32,I64:J66,I98:J100,S30:T32,S64:T66,S98:T100,V30:W32,V64:W66,V98:W100").ClearContents
For Each cl In Range("E2,E36,E70,R2,R36,R70")
y = 0
With GetObject("C:\Users\hsv\desktop\stockbeheer2017hsv.xlsm").Sheets("stockbeheer")
 With .Columns(4)
  Set c = .Find(cl, , , xlWhole)
    If Not c Is Nothing Then
        firstaddress = c.Address
         Do
            If c.Offset(, 2) > 0 Then
               y = y + 1
              cl.Offset(y + IIf(y < 4, 27, 24), IIf(y < 4, 1, 4)) = c.Offset(, 29)
              cl.Offset(y + IIf(y < 4, 27, 24), IIf(y < 4, 2, 5)) = c.Offset(, 4)
              cl.Offset(32, 7) = c.Offset(, 17)
            End If
            Set c = .FindNext(c)
         Loop While Not c Is Nothing And firstaddress <> c.Address
       End If
  End With
 End With
 Next cl
End Sub
 
Laatst bewerkt:
Harry,

Om te antwoorden op je eerste vraag, je opmerking is terecht, maar intern, ben ik Tom, toch wel de persoon die 90% van de excel sheet beheer.
Mijn vader, is in feite een back-up, en al hetgeen we tot op heden gemaakt hebben, is uitgeschreven in een "procedureboek", waar alle linken, doorverwijzingen, formules, enz staan in genoteerd.
Is trouwens voor mezelf ook handig, als ik zekerheid wil over bv een verwijzing.
de data onderhouden, en de formules aanpassen is ook een taak die momenteel nog onder controle is ......
Wel willen we je nogmaals bedanken voor de hulp, want zonder je inbreng hadden we nooit gestaan, wat we nu al bereikt hebben, en toch een beetje trots op zijn :thumb:

Wat betreft de macro:
Ik heb deze aangepast naar mijn verwijzingen (zie hieronder)

Sub hsv()
Dim c As Range, cl As Range, firstaddress As String, y As Long
Application.ScreenUpdating = False
Range("F30:G32,F64:G66,F98:G100,I30:J32,I64:J66,I98:J100,S30:T32,S64:T66,S98:T100,V30:W32,V64:W66,V98:W100").ClearContents (dit zijn de cellen die moeten ingevuld worden vanuit sheet stockbeheer)
For Each cl In Range("E2,E36,E70,R2,R36,R70") (dit zijn de invul velden die manueel gebeuren)
y = 0
With GetObject("C:\Users\tombe_000\desktop\stockbeheer2017test.xlsm").Sheets("stockbeheer")
With .Columns(4) (aantal halen uit kolom (4) "aantal)
Set c = .Find(cl, , , xlWhole)
If Not c Is Nothing Then
firstaddress = c.Address
Do
If c.Offset(, 2) > 0 Then
y = y + 1
cl.Offset(y + IIf(y < 4, 27, 24), IIf(y < 4, 1, 4)) = c.Offset(, 29)
cl.Offset(y + IIf(y < 4, 27, 24), IIf(y < 4, 2, 5)) = c.Offset(, 4)
cl.Offset(32, 7) = c.Offset(, 17)
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And firstaddress <> c.Address
End If
End With
End With
Next cl
End Sub

harry,
Ik heb deze sub in een module geplaatst in werkboek catalogus

Als ik de macro laat uitvoeren, krijg ik GEEN foutmelding, maar er gebeurt ook niks :o:o:o:o
Wat loopt er fout ?
Beide bestanden staan op mijn bureaublad.
Stockbeheer2017TEST.xlsm - catalog.xlsm
Werkt macro in jou omgeving ?

tot hoors
Tom
 
hallokes,

Begrijp niet goed wat je bedoeld om een link naar codetags te geven, dit is voor mij onbekend terrein :o:o:o:o
Wat kan ik daar extra mee ?
Sorry als ik hier een miskleun bega :o

Tom
 
Als je het had gelezen, weet je hoe je de code tags om de code krijg.
Dan komt je code net zoals bij "HSV" in een apart vak te staan.
 
Ik verkreeg ook geen resultaat (was even een test voor het later onderhouden van de code).

Code: 
Sub hsv()
Dim c As Range, cl As Range, firstaddress As String, y As Long
Application.ScreenUpdating = False
Range("F30:G32,F64:G66,F98:G100,I30:J32,I64:J66,I98:J100,S30:T32,S64:T66,S98:T100,V30:W32,V64:W66,V98:W100").ClearContents
For Each cl In Range("E2,E36,E70,R2,R36,R70")
y = 0
With GetObject("C:\Users\hsv\desktop\stockbeheer2017hsv.xlsm").Sheets("stockbeheer")
 With .Columns(4)
  Set c = .Find(cl, , xlValues, xlWhole)
    If Not c Is Nothing Then
        firstaddress = c.Address
         Do
            If c.Offset(, 2) > 0 Then
               y = y + 1
                 Union(c.Offset(, 29), c.Offset(, 4)).Copy
                 Application.Goto cl.Offset(y + IIf(y < 4, 27, 24), IIf(y < 4, 1, 4))
                 ActiveSheet.Paste , True
                 c.Offset(, 17).Copy
                 Application.Goto cl.Offset(32, 7)
                 ActiveSheet.Paste , True
            End If
            Set c = .FindNext(c)
         Loop While Not c Is Nothing And firstaddress <> c.Address
       End If
  End With
 End With
 Next cl
End Sub
 
harry,

Sub werkt perfect !
Heb hem reeds in de definitieve mappen en bestanden gezet, en werkt PRIMA :thumb::thumb::thumb::thumb::thumb:

Wat er nog ontbreekt, een sub die het tabblad "basisxlt" toevoegd (steeds achteraan) met als tabnaam de datum van aanmaak (dus al we gisteren blad toevoegen 04042017, doen we dat vandaag krijgen we 05042017, als er meer als een tabblad per dag wordt toegevoegd dan de tabblad naam aanvullen met A:B: enz (vb: 05042017A)

Dan is de catalogus ook weer volledig afgewerkt :) :thumb::thumb::thumb:

Thx alvast

Tom
 
Volgens mij heb je die code al een keer gekregen in een van je eerdere vragen.
 
Klopt harry, ben er al mee bezig, het kan wel zijn , dan ik hier even op terugkom ivm de datum in het tabblad, ik hou je op de hoogte

thx
 
Harry,

Kan je me ff verder helpen, als ik blad invoeg, werkt alles maar krijg dan als tabbladnaam "basisxlt(1), basisxlt(2), enz"
En ik had graag de datum verkregen van vandaag, en als er meerdere bladen worden op 1 dag toegevoegd, dan werken met A bv 06042017 (vandaag mijn eerste blad toegevoegd, 06042017A (wordt dan vandaag mijn 2de blad toegevoegd, enz)

De sub die momenteel draait is
Sub Bladinvoegen()
'
' Bladinvoegen Macro
'

'
Sheets("BASISXLT").Select
Sheets("basisxlt").Copy after:=Sheets(Sheets.Count)

End Sub

Thx
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan