Macro voor kopiëren dataset

Status
Niet open voor verdere reacties.
M

marc651

Gebruiker
Lid geworden
2 dec 2012
Berichten
175
Hallo,

In bij gevoegd document heb ik 2 tabellen.
War ik graag zou willen is een knop die een macro uitvoert, zodat de naam die ingevoerd wordt in cel C12 gezocht wordt in A30:A100, en de data die in B17:S21 gekopieerd wordt in de rij achter de afkorting die zojuist opgezocht is.
Dus in D30:CVJ100 moeten straks allemaal plusjes en minnetjes komen te staan en de kleuren rood en groen.

Kan iemand me daar bij helpen?

Bekijk bijlage BE-Inventariseren Beschikbaarheden docenten SEM2 2019-2020.xlsx
 
Bv

Code: 
Sub VenA()
  ar = Range("B17:R21")
  For j = 1 To UBound(ar)
    For jj = 1 To UBound(ar, 2)
      c00 = c00 & "|" & ar(j, jj)
    Next jj
  Next j
  c00 = c00 & "|" & Range("S17")
  Cells(Application.Match(Range("C12").Value, Columns(1), 0), 4).Resize(, 86) = Split(Mid(c00, 2), "|")
End Sub
 
Als je de pipe achter ar(j,jj) zet, heb de de Mid functie en de pipe voor range("s17") niet nodig.
 
HSV,
Ik begrijp niet helemaal wat je bedoeld?

VenA,
Het werkt prima. Nog een vraagje echter; Is het mogelijk een msgbox te laten verschijnen als een docentcode niet in de lijst voor komt?
 
Je kan beter gegevensvalidatie gebruiken. Dan komt de docentcode altijd voor.

Met de suggestie van @HSV (dan zie je wat er bedoeld wordt) en de melding.
Code: 
Sub VenA()
  ar = Range("B17:S21")
  For j = 1 To UBound(ar)
    For jj = 1 To UBound(ar, 2) - 1
      c00 = c00 & ar(j, jj) & "|"
    Next jj
  Next j
  c00 = c00 & ar(1, 18)
  r = Application.Match(Range("C12").Value, Columns(1), 0)
  If IsNumeric(r) Then Cells(r, 4).Resize(, 86) = Split(c00, "|") Else MsgBox Range("C12").Value & " niet gevonden"
End Sub
 
VenA,
De code werkt prima. Nu krijg ik echter een ander verzoek.
Ik had liever het plaatje in één keer helder gehad, maar ja.

Ik bestand Test1 staat het tabelletje dat ingevuld moet worden door docenten, en dat ze afzonderlijk opsturen naar een centraal iemand.
Nu zou ik dit graag willen dat deze persoon op de Macroknop drukt, en de data getransformeerd wordt naar document Test 2.
Dus, de docentcode, de Opleiding, en de aanstellingsomvang(fte). Daarachter de Beschikbaarheid(+ is groen & - is rood).
Met de "Opmerkingen" per dag achter alle groene velden(maandag, dinsdag, enz)
Ik heb de opmaak wat verandert zodat er geen samgestelde velden meer zijn die gekopieerd moeten worden.(houd VBA niet van heb ik begrepen)
Ik zou het fijn vinden als er uitleg bij de code staat zodat ik het zelf nog wat kan aanpassen.

Bekijk bijlage Test1.xlsm, Bekijk bijlage Test2.xlsm
 
Wat begrijp je niet aan de code dan? De basisgegevens worden in de variabele 'ar' gezet. Met een lusje worden deze gegevens samengevoegd tot 1 string met als scheidingsteken een pipeline. Met Application.Match wordt er gekeken of de werknemerscode gevonden kan worden. Zo ja dan de verzamelde gegevens weer splitsen en anders een melding. Dit is allemaal te volgen als je in de VB-editor met <F8> door de code loopt.

Als je gegevens uit een 2e bestand wil halen dan kan je Getobject of Application.FileDialog gebruiken om de basisgegevens in de variabele 'ar' te krijgen.
 
Laatst bewerkt:
Ok, ik begin het allemaal wat meer te begrijpen.
Ik heb het nu wat anders aangepakt.
Ik heb in bestand B2 een knop met een macro die data 1 op 1 naar een gelijke tabel kopieert naar bestand B1. dat gaat goed.
Bedoeling is om in bestand B1, rij 12 t/m 22 te verbergen zometeen.(zijn hulpcellen)

In de code van B2 heb ik de volgende code toegevoegd;
Code: 
Application.Run "'B1.xlsm'!Module1.Marco1"/CODE]

Bedoeling hiervan is om de code die ik eerder van VenA gekregen heb uit te voeren  in bestand B1.
Dit doet hij echter niet, er gebeurt helemaal niets. Zelfs niet een foutmelding.

Daarnaast heb ik geprobeerd om helemaal links kolommen toe te voegen. Met wat aanpassingen in de code werkt dit prima.
Echter, als ik ipv cel C 12 , A12 gebruik als referentie voor de docentcode, dan zet hij de reeks achter cel A12. Ik snap daar niets van. Wat zit hem dat in?

[ATTACH]345452.vB[/ATTACH][ATTACH]345453.vB[/ATTACH]
 

Bijlagen

  • B2.xlsm
    22,3 KB · Weergaven: 34
  • B1.xlsm
    49,7 KB · Weergaven: 28
Haal de macro uit B1.xlsm (is niet meer nodig). Zorg dat de bestanden in dezelfde map staan. En anders het rode gedeelte aanpassen. Gebruik deze code voor B2.xlsm

Code: 
Sub VenA()
  ar = Range("B12:S21")
  For j = 6 To UBound(ar)
    For jj = 1 To UBound(ar, 2) - 1
      c00 = c00 & ar(j, jj) & "|"
    Next jj
  Next j
  c00 = c00 & ar(6, 18)
  With GetObject([COLOR="#FF0000"]ThisWorkbook.Path & "\B1.xlsm"[/COLOR]).Sheets("Beschikbaarheid")
    r = Application.Match(ar(1, 2), .Columns(1), 0)
    If IsNumeric(r) Then .Cells(r, 4).Resize(, 86) = Split(c00, "|") Else MsgBox ar(1, 2) & " niet gevonden"
  End With
End Sub
 
De laatste vraag is opgelost. Ik mag de code die ik op wil zoeken niet in dezelfde kolom zetten als de Range waar ik wil zoeken.
 
VenA.
Ik krijg een foutmelding in deze regel;
With GetObject(ThisWorkbook.Path & "MacMalu\Gebruikers\Marc\Bureaublad\B1.xlsm").Sheets("Beschikbaarheid")
Heb beide bestanden open staan op het bureaublad. Ook zonder het hele pad geeft hij de foutmelding
 
De Meldin is;
Bestandsnaam of klassenaam is niet gevonden tijdens de automatiseringsbewerking
 
Lijkt mij logisch. Als je niet weet hoe de mappenstructuur in elkaar steekt dan gaat dit een lang verhaal worden.

Open het bestand B1.xlsm ga in de VB-Editor naar het immediate venster en kopieer of type het volgende
Code: 
debug.Print thisworkbook.fullname
En duk op <Enter> nu weet je het volledige pad en de naam van het bestand.
 
Ik heb hem even getest in mijn werkomgeving. Daar werkt hij prima. behalve dat hij alleen in de eerste cel; de kleur verandert.
 
Je hebt de voorwaardelijke opmaak niet goed ingesteld.
 
Fout gevonden. Zat hem in de opmaak.
Heel erg bedankt VenA. Super.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan