• 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.

Export obv keuze opties

Status
Niet open voor verdere reacties.
H

HJ1

Gebruiker
Lid geworden
3 sep 2021
Berichten
73
Ik heb een aantal keuze opties die uiteindelijk moeten lijden tot één blad met samengevoegde velden.

1) In veld C7 wordt standaard 1 naam ingevuld

2) Vanaf rij 15 staan 3 blokken waarin voor deze persoon diverse Vakken aangekruist kunnen worden

3) Voor deze persoon kan een vraag gedaan worden uit A) Opties en B) Subopties
Aan de A) Opties en B) Subopties zitten onderliggende groepen gekoppeld, deze zijn bekend in tabblad 'Opties' en 'Subopties'.
Dezes gelden dan voor alle vakken voor de persoon.

Nu moet ik al deze gegevens samenbundelen op het werkblad 'Output', hoe krijg ik dit in logische stappen in VBA goed samen?

Hopelijk kan iemand mij helpen en heb ik het een beetje duidelijk uitgelegd :)
 

Bijlagen

  • 03 samenvoegen.xlsm
    19,1 KB · Weergaven: 50
Ik ben niet onder de indruk van je eigen VBA-aktiviteiten.
Helpmij ondersteunt in dit subforum progarmmeurs die vastlopen met hun projekt.
Helpmij is een geen gratis extern softwareburo; het heeft bovendien, in tegenstelling tot jouw werkgever, geen Coronasteun ontvangen.
Waarom schakelen jullie niet gewoon tegen betaling een VBA-expert in ?
 
Laatst bewerkt:
snb zei:
Ik ben niet onder de indruk van je eigen VBA-aktiviteiten.
Klik om te vergroten...
Bedoel je deze macro?
Code: 
Sub samenvoegen_opties()
    Sheets("Invul").Select
    Range("A1").Select
    Sheets("Output").Select
    Range("A1").Select
End Sub

Daar zou ik eerlijk gezegd ook geen geld voor over hebben :d.
 
Het is maar een deel van mijn gehele rapportage vandaar dat ik de rest van de code eruit heb gehaalt. En je hebt gelijk, ik ben idd geen master zoals jullie hierin :thumb: en hoop hier van jullie ook weer wat te leren.
 
Ben zelf al stukje verder gekomen met enkele formules en extra velden.
PHP: 
=ALS($D13="";"";$D$11&";"&VERT.ZOEKEN(D13;OPTIES!A:C;3;ONWAAR))

PHP: 
=ALS($G13="";"";$D$11&";"&VERT.ZOEKEN(G13;OPTIES!E:G;3;ONWAAR))

Ben alleen nog zoekende hoe de Toegang tot een vak * opties L13:L16 en subopties O13:O16 (indien gevuld) gedaan kan worden.
Zoals op "Output" blad in kolom D.
 

Bijlagen

  • 03 samenvoegen 2.xlsm
    20,1 KB · Weergaven: 6
hier een vba beginnetje: knopje zit in de laatste pagina.

zelf verder aanpassen. uitleg kun je altijd vragen
 

Bijlagen

  • 03 samenvoegen met vba .xlsm
    33,1 KB · Weergaven: 13
Het lukt me redelijk om dit te definiëren

Blok1: de opties bepalen (kolom I)
Blok2: bepaalde de kruisjes of te wel de toegang (kolom H)

Maar in welk stukje zit de verwijzing naar deze velden?
sheet: output
Kolom H en kolom I

Zelf krijg ik momenteel alleen nog geen output dus daar moet ik nog naar zoeken.
 
blok1 zijn de opties en de subopties.
blok2 zijn de vakken

in de sub "test" worden voor ieder vak uit blok2 de alle gevonden waarden van blok1 toegevoegd.
 
Ik bedoel eigenlijk, nu komt de output in

werkblad: output
Kolom H en kolom I


Wat als je dit toch op een andere locatie wilt hebben bv.:
werkblad: Samenvatting
Kolom A en kolom I


UB1 = UBound(B1) = opties + subopties
UB2 = UBound(B2) zijn het aantal kruisjes
 
deze werkt makkelijker: hij heeft alleen udfjes (functies) zie donkergele cellen in het voorblad.

er staan 2 voorbeelden :

eerste met hulpkolommen blok1 en blok2

tweede zonder hulpkolommen
 

Bijlagen

  • 03 samenvoegen met vba (3.xlsm
    32,2 KB · Weergaven: 17
Laatst bewerkt:
Ik heb nog een detail wat ik maar niet opgelost krijg.

Veld formule: =Blok1metBlok2(Blok2(T_Toegang1;T_Toegang2;T_Toegang3);Blok1(Invullen!$D$10;T_Opties[Opties];Functies_groepen;T_Subopties[Subopties];Subfuncties_groepen))

In BLOK1 wordt nu een transpose gebruikt van de Optie tabel maar eigenlijk zou ik alleen uit die tabel de waarde van kolom 3 willen tonen.
Na mijn mening zit het hem in dit stuk van BLOK1....hij gaat nu alle waarden transponeren....

j = Trim(Join(.Transpose(.Transpose(Temp.Resize(, OptieTabel.Columns.Count)))))
D(T) = Naam.Value & " " & j

Daarnaast begrijp ik ook niet waarom je in deze formule de verwijzing naar D10 niet kan verwijderen......
PHP: 
Blok1(Invullen!$D$10;


Code: 
'blok1          | formule: =Blok2(T_Toegang1;T_Toegang2;T_Toegang3)
'blok2          | formule: =Blok1($D$10;T_Opties[Opties];Functies_groepen;T_Subopties[Subopties];Subfuncties_groepen)

'blok1 en 2 kunnen ook in één formule staan, dat is deze optie blok1enblok2:
'blok1enblok2   | formule: =Blok1metBlok2(Blok2(T_Toegang1;T_Toegang2;T_Toegang3);Blok1($D$10;T_Opties[Opties];Functies_groepen;T_Subopties[Subopties];Subfuncties_groepen))

Function Blok1metBlok2(B1, B2)
With WorksheetFunction
  B1 = .Transpose(.Transpose(B1))
  B2 = .Transpose(.Transpose(B2))
End With
ReDim Opl(0 To UBound(B1) * UBound(B2) - 1, 1)
For Each item1 In B1
  For Each item2 In B2
    Opl(T, 0) = item1
    Opl(T, 1) = item2
    T = T + 1
  Next
Next
Blok1metBlok2 = Opl
End Function
Code: 
Function Blok1(Naam As Range, Opties As Range, OptieTabel As Range, Subopties As Range, SuboptieTabel As Range)
  Dim D, Temp As Range, T As Integer, Blok()
  Set D = CreateObject("scripting.dictionary")
  With WorksheetFunction
  For Each opt In Opties
    If opt <> "" Then
      Set Temp = OptieTabel.Columns(1).Find(opt, , , xlWhole)
      If Not Temp Is Nothing Then
        j = Trim(Join(.Transpose(.Transpose(Temp.Resize(, OptieTabel.Columns.Count)))))
        D(T) = Naam.Value & " " & j
        T = T + 1
      End If
    End If
  Next
  For Each opt In Subopties
    If opt <> "" Then
      Set Temp = SuboptieTabel.Columns(1).Find(opt, , , xlWhole)
      If Not Temp Is Nothing Then
        j = Trim(Join(.Transpose(.Transpose(Temp.Resize(, SuboptieTabel.Columns.Count)))))
        D(T) = Naam.Value & " " & j
        T = T + 1
      End If
    End If
  Next
  Blok1 = .Transpose(D.items)
  End With
End Function
Code: 
Function Blok2(ParamArray G())
  With CreateObject("scripting.dictionary")
    For n = 0 To UBound(G)
      For nn = 1 To G(n).Rows.Count
        If G(n)(nn, 1) = "x" Or G(n)(nn, 1) = "X" Then Temp = .Item(G(n)(nn, 2).Value)
        Next
    Next
    Blok2 = WorksheetFunction.Transpose(.keys)
  End With
End Function

Wat ik eigenlijk zou willen, zie blad "Output wenselijk"
Kolom 1 = vast waarde uit Blad "Invul" veld D10
Kolom 2 = Blok 1
Kolom 3 = Blok 2

Hopelijk kan iemand mij verder helpen. Thanks.
 

Bijlagen

  • Temp Blokken.xlsm
    47,4 KB · Weergaven: 5
Laatst bewerkt:
Excuus, hierbij zonder wachtwoord.
 

Bijlagen

  • Temp Blokken vba.xlsm
    47,4 KB · Weergaven: 3
Top dit werk geweldig!
Snap alleen niet waarom $D$10 zoveel invloed heeft op de formule...

Nog ander klein vraagje, ik wil het Output blad opslaan als csv maar wanneer ik dit handmatig doe gaat het goed maar via deze macro worden om de waarden van kolom C Kwootjes gezet...


Code: 
Dim stPath2 As String
Sheets("Output").Select
With ActiveWorkbook.Sheets
    stPath2 = "G:\mijn documenten\csv\"
    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(stPath2) Then .CreateFolder stPath2
    End With
    ActiveWorkbook.SaveAs Filename:=stPath2 & Sheets("Invullen").Range("D10") & " - " & Sheets("Invullen").Range("I9") & " - " & Sheets("Invullen").Range("E6") & ".csv", FileFormat:=xlCSVUTF8
    ThisWorkbook.Close
End With
 
dit werkt bij mij:
wel zoren dat het juiste werksheet in beeld is
Code: 
Sub Macro2()
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\joset en sylvester\Downloads\Temp Blokken 5 34.csv", FileFormat:=xlCSV, [COLOR="#FF0000"]local:=True[/COLOR]
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan