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

Cel leeg bij zelfde uitkomst en andere cellen overlappen met uitkomst

Status
Niet open voor verdere reacties.
L

Lammers13

Gebruiker
Lid geworden
15 sep 2017
Berichten
9
Hallo allemaal,

Zie bijlage

Ik wil graag dat als de uitkomsten in de cel (in dit geval Remco Lammers) hetzelfde zijn voor een aantal cellen achter elkaar, dat alleen de eerste cel van de reeks de tekst bevat en de andere leeg zijn. Daarnaast wil ik dan ook dat de tekst uit de eerste cel de opeenvolgende cel(len) overlapt.

Ik hoop dat iemand mij kan helpen.

Groet,

Remco
 

Bijlagen

  • Test.xlsx
    27 KB · Weergaven: 48
Kun je hier iets mee?
 

Bijlagen

  • Test-1.xlsx
    12,8 KB · Weergaven: 33
Ik dacht aan een macrootje.
Code: 
Sub hsv()
Dim sn, rij, i As Long, kolombegin, kolomeinde
sn = Sheets("blad1").Cells(1).CurrentRegion
With Sheets("blad2")
   For i = 2 To UBound(sn)
    rij = Application.Match(sn(i, 1), .Columns(1), 0)
       If Not IsError(rij) Then
         .Rows(rij).UnMerge
         .Cells(rij, 2).Resize(, 20).ClearContents
         kolombegin = Application.Match(CLng(sn(i, 2)), .Rows(1), 0)
         kolomeinde = Application.Match(CLng(sn(i, 3)), .Rows(1), 0)
    
        .Range(.Cells(rij, kolombegin), .Cells(rij, kolomeinde)).Merge
        .Cells(rij, kolombegin).Interior.ColorIndex = 6
        .Cells(rij, kolombegin) = sn(i, 1)
        .Cells(rij, kolombegin).HorizontalAlignment = xlVAlignCenter
      End If
  Next i
 End With
End Sub

Ps. geen controle op match voor de datum (geen tijd, moet weg).
 
HSV zei:
Ik dacht aan een macrootje.
Code: 
Sub hsv()
Dim sn, rij, i As Long, kolombegin, kolomeinde
sn = Sheets("blad1").Cells(1).CurrentRegion
With Sheets("blad2")
   For i = 2 To UBound(sn)
    rij = Application.Match(sn(i, 1), .Columns(1), 0)
       If Not IsError(rij) Then
         .Rows(rij).UnMerge
         .Cells(rij, 2).Resize(, 20).ClearContents
         kolombegin = Application.Match(CLng(sn(i, 2)), .Rows(1), 0)
         kolomeinde = Application.Match(CLng(sn(i, 3)), .Rows(1), 0)
    
        .Range(.Cells(rij, kolombegin), .Cells(rij, kolomeinde)).Merge
        .Cells(rij, kolombegin).Interior.ColorIndex = 6
        .Cells(rij, kolombegin) = sn(i, 1)
        .Cells(rij, kolombegin).HorizontalAlignment = xlVAlignCenter
      End If
  Next i
 End With
End Sub

Ps. geen controle op match voor de datum (geen tijd, moet weg).
Klik om te vergroten...

Bedankt voor de macro. Ik heb de tekst in een macro geplakt in mijn sheet. Maar daarna is mijn kennis van macro's t beperkt. War is nu mijn volgende stap?

Alvast bedankt.
 
A.u.b. niet herhalen wat ik heb geschreven.
Pak de 'reageer op bericht' i.p.v. de 'quote' knop.

Ik kan een er een lang verhaal van maken, maar ik heb onderstaande code in bladmodule "blad2" geplaatst in de bijlage.
Code: 
Private Sub Worksheet_Activate()
Dim sn, rij, i As Long, kolombegin, kolomeinde
      sn = Sheets(1).Cells(1).CurrentRegion
   For i = 2 To UBound(sn)
    rij = Application.Match(sn(i, 1), Columns(1), 0)
    kolombegin = Application.Match(CLng(sn(i, 2)), Rows(1), 0)
       If Not IsError(rij) And Not IsError(kolombegin) Then
         Rows(rij).UnMerge
         Cells(rij, 2).Resize(, 20).Clear
         Cells(rij, kolombegin).Resize(, CLng(sn(i, 3)) - CLng(sn(i, 2)) + 1).Merge
         Cells(rij, kolombegin).Interior.ColorIndex = 6
         Cells(rij, kolombegin) = sn(i, 1)
         Cells(rij, kolombegin).HorizontalAlignment = xlVAlignCenter
       End If
   Next i
End Sub

Je hoeft niets anders te doen dan gegevens invullen en kijken in blad 2 naar het resultaat.

Of:
Code: 
Private Sub Worksheet_Activate()
Dim sn, rij, i As Long, kolombegin, kolomeinde
      sn = Sheets(1).Cells(1).CurrentRegion
   For i = 2 To UBound(sn)
    rij = Application.Match(sn(i, 1), Columns(1), 0)
    kolombegin = Application.Match(CLng(sn(i, 2)), Rows(1), 0)
      [COLOR="#0000FF"] If Not IsError(rij) Then[/COLOR]
         Rows(rij).UnMerge
         Cells(rij, 2).Resize(, 20).Clear
           [COLOR="#0000FF"] if not iserror(kolombegin) then[/COLOR]
              Cells(rij, kolombegin).Resize(, CLng(sn(i, 3)) - CLng(sn(i, 2)) + 1).Merge
              Cells(rij, kolombegin).Interior.ColorIndex = 6
              Cells(rij, kolombegin) = sn(i, 1)
              Cells(rij, kolombegin).HorizontalAlignment = xlVAlignCenter
            End If
        [COLOR="#0000FF"]end if[/COLOR]
   Next i
End Sub

Of gebruik 'on error resume next' op de tweede blauwe regel voor alle mogelijke foutieve invoer.
 

Bijlagen

  • match.xlsb
    15,6 KB · Weergaven: 34
Laatst bewerkt:
Beste heer Harry,

Enorm bedankt voor je hulp zover. Het komt zeker in de buurt van wat ik voor ogen heb. VBA is helemaal nieuw voor mij, maar zeker iets waar ik in wil duiken.

Paar kleine vraagjes nog:

1: Nu wordt in de gele cellen het kamernummer weergegeven, maar zou graag willen dat de naam wordt weergegeven van de persoon die op die kamer verblijft.

2: Als ik in blad 1 het kamernummer wijzig naar een ander kamernummer dan gebeurt dat ook netjes in blad 2, maar de oude situatie verdwijnt dan niet. Is dat ook op te lossen.

3: Is het ook mogelijk om in een extra kolom in blad 1 te kunnen kiezen welke kleur wordt weergegeven in blad 2.

Alvast bedankt weer!!

Remco
 
Zoiets Remco?
 

Bijlagen

  • match2.xlsb
    16,3 KB · Weergaven: 46
Beste Harry,

Sorry voor de late reactie. Ik woon en werk in Mozambique en was even in NL voor vakantie. Nu weer in Mozambique.

Je laatste oplossing is zeker wat ik zoek. Ik heb hier in Mozambique inmiddels de bestanden waar ik jouw oplossing voor wil gebruiken. Mag ik je later dat bestand sturen om de code daar in te zetten?

Ik heb inmiddels een VBA curses gevonden op internet waar ik mee ben begonnen. Erg leuk!

Groet,

Remco
 
Het kan niet privé Remco.

Het bestand kan je hier plaatsen, maar ik zou er geen gevoelige info in zetten. ;)
 
Hi Harry,

It's me again.

Hierbij vind je het bestand zonder gevoelige info. Het gaat om de sheets RC 2017 en Com Schedule.

Ik zou graag de informatie uit sheet Com Schedule - kolommen A tm G automatisch in sheet RC 2017 willen hebben zoals in jouw laatste voorbeeld. Indien mogelijk met de namen uit kolom A en B links uitgelijnd.

Daarnaast graag de team naam uit kolom O in de regel boven de kamer waar de desbetreffende persoon verblijft en ter hoogte van verblijf. In het bestand heb ik één van die regels ingekleurd als voorbeeld. De team naam ook graag links uitgelijnd. En hier hoeft geen kleur bij.

Voel je vrij om de layout te wijzingen indien nodig of laat het mij weten als er iets veranderd moet worden om dit alles voor elkaar te krijgen.

Super bedankt alvast!

Groet,

Remco
 

Bijlagen

  • Year Room Calender 2017.xlsm
    651,1 KB · Weergaven: 36
Hallo Remco,

Waaruit kan ik opmaken waar de desbetreffende persoon geplaatst moet worden voor het verblijf.

Beetje ingewikkelde vba constructie zal dat worden qua layout (special rooms, Lower rooms, bed1, bed2 , bed3 enz.).
Er schiet mij nog niets te binnen om dat zo eventjes in te vullen.


 
Hi Harry,

Goed punt! Ik heb alle bedden nu een uniek nummer gegeven in kolom A (sheet RC 2017) en de rijen met personen (sheet Com Schedule) voorzien van een uniek bednummer. Is het dan makkelijker om een VBA constructie te maken? Of is het noodzakelijk de layout volledig aan te passen.

Groet,

Remco
 

Bijlagen

  • Year Room Calender 2017.xlsm
    652,5 KB · Weergaven: 33
Bekijk het maar eens Remco.
 

Bijlagen

  • Year Room Calender 2017.xlsb
    246,5 KB · Weergaven: 35
Hi Harry,

Dat komt al heel aardig in de buurt. Alleen als ik switch tussen de twee sheets, dan zijn de namen en de kleuren niet meer zichtbaar op RC 2017. Ook valt een hoop van de opmaak weg.

Om dat laatste op te vangen heb ik de opmaak aangepast en simpeler gemaakt, misschien helpt dat. Nieuw bestand vind je in de bijlage.

Remco
 

Bijlagen

  • Year Room Calender 2017 Test.xlsb
    179,6 KB · Weergaven: 42
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan