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

Zoeken in meerdere tabbladen

Status
Niet open voor verdere reacties.
G

Glenno

Gebruiker
Lid geworden
12 okt 2007
Berichten
159
Hallo allemaal,

Ik heb een (volgens mij) zeer ingewikkelde vraag/uitdaging. Wat ik wil kan ik bedenken, maar de oplossing/formule niet.

Zie bijgevoegd bestand.

1.
Het tabblad "The Day" genereert in cel A2 automatisch de "huidige dag" ( functie: =VANDAAG ). De "huidige dag" moet gezocht worden in alle andere tabbladen.
In het tabblad waar de datum gevonden wordt, kunnen meerdere regels aan de datum voldoen, kolom D.

2. De kolommen F en K geven aan gedurende welke tijdsperiode in het tabblad The Day "geblockt" moet worden.

3. Voorts moet gekeken worden welke "room" in tabblad The Day "geblockt" moet worden. Zie hiervoor kolom J.

4. Tot slot moeten de gegevens uit kolom I en G van de betreffende regel, worden opgehaald en getoond worden in de tijdsperiode van tabblad The Day. Het wordt overzichtelijker wanneer de geblockte tijdsperiode ook een (rood) kleurtje krijgt.

Ik weet niet of mijn verzoek te maken en/of mogelijk is. Het zou me in ieder geval ontzettend veel handwerk en dubbel werk schelen.

Alvast dankend voor de hulp/inspanning/tijd.

Groetend, Glenno
 

Bijlagen

Waarom gebruik je Outlook hier niet voor? Excel is rekenen. Outlook is meer van de agenda's
 
Dit is slechts een onderdeel van het geheel.
Ik zou ook niet weten hoe ik Outlook zou kunnen integreren met Excel en rekenwerk laten uitvoeren.
 
Ik ben ervan uitgegaan dat de dag van vandaag alléén voorkomt in de corresponderende maand-tab.
Dan:
Code: 
Sub HelpMij()
Sheets("The Day").Range("C6:K57").Interior.ColorIndex = x1None
Sheets("The Day").Range("C6:K57").ClearContents
For Each Sh In Sheets
    If UCase(Sh.Name) = UCase(Format(Date, "mmmm")) Then
        For Each Cel In Sheets(Sh.Name).Range("D4:D353")
            If Cel.Value = "" Then
                Exit For
            End If
            If Cel.Value = Date Then
                Kolom = (Cel.Offset(, 6) * 2) + 1
                RijStart = Round((Cel.Offset(, 2) * 96) - 31, 0)
                RijEind = Round((Cel.Offset(, 7) * 96) - 31, 0) - 1
                Sheets("The Day").Range(Cells(RijStart, Kolom), Cells(RijEind, Kolom)).Interior.ColorIndex = 3
                Sheets("The Day").Range(Cells(RijStart, Kolom), Cells(RijEind, Kolom)) = Cel.Offset(, 3) & ": " & Cel.Offset(, 5)
            End If
        Next Cel
    End If
Next
End Sub
 
Laatst bewerkt:
Goedemorgen Conseclusie,

Dit is inderdaad wat ik bedoelde.

Ik heb nog slechts 2 (kleine) probleempjes:
1. In het voorbeeldbestand werkt de code. Op de een of andere manier werkt het niet in het originele bestand. Ik kan, omdat ik geen code kan lezen, niet achterhalen waar het mis gaat.
2. De eindtijd is in "The Day" een kwartier te kort. (Hij geeft het aan tot de eindtijd en niet tot en met de eindtijd)

Vind je het goed dat ik het originele bestand aan je toestuur?

Alvast ontzettend bedankt voor je inspanningen.

Groet, Glenno
 
Mbt de eindtijd; voor tot en met verwijder je de -1 aan het eind van
Code: 
RijEind = Round((Cel.Offset(, 7) * 96) - 31, 0) - 1
Kun je het orginele bestand niet gewoon hier plaatsen? (ontdaan van privacy-gevoelige info)
 
Conseclusie,

De eindtijd klopt nu.

Alleen wanneer ik wijzigingen aanbreng in bijv. de start- en eindtijd of de room, dan gebeurt er niets.
Ik zal ongetwijfeld iets verkeerd doen. (Onkunde; sorry )

Bijgaand doe ik toch maar het originele bestand. Ik heb de datumnotatie (7-11) alleen voor de maand november aangepast. De andere maanden heb ik nog even niet gedaan.

Nogmaals diepe buiging en dank.

Glenno
 

Bijlagen

Als je wijzigingen aanbrengt zal de macro wel opnieuw gerund moeten worden; daily agenda zal zich niet vanzelf aanpassen.
Hiervoor heb ik een knop toegevoegd in tab "The Day". Daarnaast heb ik die =VANDAAG()-formule verwijderd; VBA bepaalt de huidige dag al mbv DATE.
Wat er (in de toekomst) wellicht nog wél fout kan gaan heeft betrekking op de namen van de maand-tabs. In de VBA-code wordt gezocht naar de tab, waarvan de naam correspondeert met de huidige maand.
Ik gebruik zelf een Nederlandse excel-versie, dan zal de code op 1-1-2020 zoeken naar de tab met de naam "Januari". Omdat jij de Engelse maandnamen gebruikt zou dat een fout kunnen opleveren. Pas in dat geval die tab-namen aan naar de Nederlandse maand-namen. (Dit probleem speelt niet bij november, omdat de spelling in beide talen gelijk is)
 

Bijlagen

Conseclusie,

Ontzettend bedankt. Het werkt perfect.

Groet, Glenno
 
Hallo Conseclusie,

Mag ik je nog 1 ding vragen?

Ik wil graag kolom E verwijderen. In de vorige versie had ik de berekening in kolom O afhankelijk gemaakt van kolom E.
Dit heb ik inmiddels veranderd en is kolom E niet meer nodig.
Als ik deze echter verwijder, krijg ik een foutmelding. Ik weet helaas niet wat ik moet doen als ik een kolom verwijder of toevoeg. Kun jij svp alleen deze wijziging nog doorvoeren in de door jou gemaakte code?

Nogmaals diepe dank.

Glenno
 

Bijlagen

Als je in de maand-tabbladen kolom E verwijdert, dan moet je in de VBA-code alle Offset-verwijzingen met 1 verlagen.
Dus:
Code: 
Cel.Offset(, 6)
wordt:
Code: 
Cel.Offset(, 5)
Zo ook met de andere 4 Offsets...
 
Hallo Conseclusie,

Het werkt SUPER. Dankjewel.
Mocht je op vakantie gaan naar Chiang Mai (Thailand), laat het me weten, dan zorg ik dat je een GRATIS massagebehandeling krijgt van 2 uur. Stuur me een bericht naar glen@glenno.nl

Groet en onwijs bedankt.

Glenno
 
Ik zal het in m'n achterhoofd houden als ik daar toevallig in de buurt ben.
Graag gedaan!
 
Hallo Conseclusie,

Er gaat toch blijkbaar iets niet goed. Alles werkte zoals verwacht.
Per abuis heb ik een keer de "room" niet ingevuld. (maand november) en vervolgens de button "Make Daily Agenda" ingedrukt.
Sindsdien werkt de macro (klaarblijkelijk) niet meer. Zowel de werkmap als de pc opnieuw opgestart.

Hoe los ik dit nu weer op en wat is er aan te doen als er per abuis een invoerfout gemaakt wordt?

Groet, Glenno
 
Het kamernummer bepaalt het kolomnummer in "The Day". Indien dit nummer ontbreekt wil de macro dus iets toevoegen in de (niet bestaande) kolom 0, waardoor een foutmelding verschijnt. Dit kun je ondervangen met (bijvoorbeeld) een waarschuwing. Dus indien het kamernummer ontbreekt verschijnt een melding, maar de macro loopt wel gewoon door.
Probeer deze eens:
Code: 
Sub HelpMij()
Sheets("The Day").Range("C6:K57").Interior.ColorIndex = x1None
Sheets("The Day").Range("C6:K57").ClearContents
For Each Sh In Sheets
    If UCase(Sh.Name) = UCase(Format(Date, "mmmm")) Then
        For Each Cel In Sheets(Sh.Name).Range("D4:D353")
            If Cel.Value = "" Then
                Exit For
            End If
            If Cel.Value = Date Then
                If Cel.Offset(, 5) > 0 Then
                    Kolom = (Cel.Offset(, 5) * 2) + 1
                    RijStart = Round((Cel.Offset(, 1) * 96) - 31, 0)
                    RijEind = Round((Cel.Offset(, 6) * 96) - 31, 0)
                    Sheets("The Day").Range(Cells(RijStart, Kolom), Cells(RijEind, Kolom)).Interior.ColorIndex = 3
                    Sheets("The Day").Range(Cells(RijStart, Kolom), Cells(RijEind, Kolom)) = Cel.Offset(, 2) & ": " & Cel.Offset(, 4)
                    Else:
                        MsgBox Cel.Offset(, 2) & ": " & Cel.Offset(, 4), vbExclamation, "Kamernummer ontbreekt"
                End If
            End If
        Next Cel
    End If
Next
End Sub
 
Het is allemaal net wat je wilt. Zelf zou ik voorwaardelijke opmaak gebruiken ipv de kleuren via VBA af te handelen. Als de tabnamen toch al bestaan dan kan die lus er ook wel tussen uit.
Code: 
Sub VenA()
  ar = Sheets(Format(Date, "mmmm")).Cells(3, 1).CurrentRegion
  With Sheets("The Day")
    .Range("C6:K57").ClearContents
    For j = 2 To UBound(ar)
      If Date = ar(j, 4) Then
        If ar(j, 6) <> "" And ar(j, 10) <> "" And ar(j, 11) <> "" Then
          .Cells(Int(ar(j, 6) * 96) - 30, Application.Match("Room " & ar(j, 10), .Rows(3), 0)).Resize((ar(j, 11) - ar(j, 6)) * 96) = ar(j, 7) & ": " & ar(j, 9)
        End If
      End If
    Next j
  End With
End Sub
 
Heren,

Jullie hebben me weer UITSTEKEND geholpen. Vooralsnog heb ik de code van Conseclusie gebruikt. Het werkt (goed).
De code van VenA ga ik ook nog uittesten op een kopie van het bestand.

Dank jullie wel.

Groet, Glen
 
Wat gaat er (nu) mis

Hallo,

Ik weet niet of dat de reden is, maar gisteren een update van windows 10 uitgevoerd.
Nu doet de macro het om, voor mij, onbegrijpelijke redenen het niet meer. Doe ik iets verkeerds?

Bijgaand het bestand.

Groet,

Glen.
 

Bijlagen

Dat zit 'm waarschijnlijk in het feit dat je een lege regel hebt gelaten in november (de rij boven je laatst toegevoegde record van 14-11).
Zodra de macro in de D-kolom een lege cel tegenkomt stopt hij ermee.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan