De 1-tjes met naam, achternaam en pasnummer op apart tabblad + volgorde laag > hoog??

  • Onderwerp starter Onderwerp starter samui
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
S

samui

Verenigingslid
Lid geworden
26 mei 2012
Berichten
207
Allen,

Ik krijg 2 x per dag voor de D en A bijgevoegd bestand toegemaild ( zonder tabblad UZK F dat ga ik gebruiken)
De groene balk is voor mij om te zien wie komt werken die dag/shift.
Een 1 is werken al het andere is afwezig in voorbeeld kolom M.
Wat ik zou willen is dat ik op de D, A of N van de dan desbetreffende groene balk kan gaan staan en dat de macro vervolgens de rij met mensen met een 1
op de manier terechtkomen, d.m.v. 1 klik, zoals ik ze in het tabblad UZK F heb ingevuld.

Dus iedereen op D van 3-8-2016 die een 1 heeft achter zijn/haar naam met 1 klik naar tabblad UZK en aansluitend op volgorde van laag naar hoog qua nummer. De eventuele 1-tjes bij de totalen mogen niet meedoen.

Ik krijg v/e 2e bureau ook een lijst met namen, andere bestand/indeling maar als ik een macro krijg zoals hierboven uitgelegd kan ik het wel ook voor dat bestand gebruiken.

Is dit mogelijk? Ik zoek en schrijf me nu in de rondte om de 1-tjes eruit te filteren.
Zie bijlage. Hoop op jullie hulp.
Alvast bedankt voor reacties.

Frank
 

Bijlagen

Ik zie alleen maar groene dingen dus wat een groene balk is? Lees eens iets over tabellen en een correcte structuur van een dataopzet. Je maakt gebruik van 'subtotalen' waardoor je niet met een autofilter kan werken.

Door gebruik te maken van het BeforeDoubleClick Event en het gebruik van Areas zal het wel mogelijk zijn. Als je bestanden in een andere opzet krijgt, en zelf aangeeft dat het dan wel lukt, dan laat de eerste opzet maar zien. De uitkomst in het blad 'UZK F' lijkt mij ook niet echt doordacht.
 
't Is wat.
Code: 
Sub hsv()
Dim sh As Worksheet
Application.ScreenUpdating = False
Set sh = Sheets("UZK F")
If ActiveCell.Row = 5 And ActiveCell = "A" Or ActiveCell = "D" Or ActiveCell = "N" Then
 sh.[f1].CurrentRegion.Clear
    With Range("a5:u46")
      .AutoFilter ActiveCell.Column, 1
      ActiveSheet.AutoFilter.Range.Offset(1).Resize(, 3).Copy sh.[f1]
      .AutoFilter
    End With
    With Range("a55:u85")
      .AutoFilter ActiveCell.Column, 1
      ActiveSheet.AutoFilter.Range.Offset(1).Resize(, 3).Copy sh.Cells(Rows.Count, 6).End(xlUp).Offset(1)
      .AutoFilter
    End With
 sh.[f1].CurrentRegion.Sort sh.[f1]
 End If
End Sub
Om te vergelijken maar even in F1 (veranderen naar A1 indien goed bevonden).
 
VenA zei:
Ik zie alleen maar groene dingen dus wat een groene balk is? Lees eens iets over tabellen en een correcte structuur van een dataopzet. Je maakt gebruik van 'subtotalen' waardoor je niet met een autofilter kan werken.

Door gebruik te maken van het BeforeDoubleClick Event en het gebruik van Areas zal het wel mogelijk zijn. Als je bestanden in een andere opzet krijgt, en zelf aangeeft dat het dan wel lukt, dan laat de eerste opzet maar zien. De uitkomst in het blad 'UZK F' lijkt mij ook niet echt doordacht.
Klik om te vergroten...

Ik begrijp wat je bedoeld met ik zie alleen maar groene dingen, maar dit is het bestand waar mee gewerkt door mijn extern bureau. Ik kan hun file niet verplicht aanpassen dus hier moet ik, helaas het mee doen.
Maar zoals je hieronder ziet Harry kwam met de juiste oplossing. TOch bedankt en wellicht dat jij mij de volgende keer weer uit de brand helpt.

mvg,

Frank
 
Om te vergelijken maar even in F1 (veranderen naar A1 indien goed bevonden).

Beste Harry,

Superbedankt precies zoals uitgelegd door mij is jouw stukje ingevuld.
Ik moet het doen met hetgeen ik aangeleverd krijg en dat is dit bestand.
Jij ziet door de bomen wel een bos.

Ik ga hem nog wat opschonen met lijntjes erom heen voor makkelijk lezen als geprint is en groene vlakken weghalen etc.
Voor nu superbedankt en graag tot een volgende keer.
Nogmaals toppie

met vriendelijke groet,
Frank
 
't is wat anders geworden.
Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("F5:U5")) Is Nothing Then
    With Blad2
    .Cells.Clear
        For Each ar In Range("A7:U46,A56:U86").Areas
            With ar
                .AutoFilter Target.Column, "1"
                .Cells.Resize(, 3).Copy Blad2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
                .AutoFilter
            End With
        Next ar
    .Cells(1).CurrentRegion.Sort .[A1]
    End With
End If
Cancel = 0
End Sub
 
Laatst bewerkt:
Zie je het bos ook @VenA, alleen jammer van de
Worksheet_BeforeDoubleClick
Klik om te vergroten...
. :D

samui zei:
d.m.v. 1 klik.
Frank
Klik om te vergroten...

Ik denk dat het met onderstaande net allemaal wat beter loopt (bij geen gegevens, juiste gegevens van de dubbelklik van kolom F, de cancel=true, de kleurtjes)

Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim ar As Range
If Not Intersect(Target, Range("F5:U5")) Is Nothing Then
Application.ScreenUpdating = False
    With Blad2
    .Cells.Clear
        For Each ar In Range("A5:U46,A54:U85").Areas
            With ar
                .AutoFilter Target.Column, 1
                .Offset(1).Resize(, 3).Copy Blad2.Cells(Rows.Count, 1).End(xlUp).Offset(IIf(IsEmpty(Blad2.[a1]), 0, 1))
                .AutoFilter
            End With
        Next ar
     With .Cells(1).CurrentRegion
      If Not IsEmpty(.Parent.[a1]) Then .Sort .Parent.[a1]
         .Interior.ColorIndex = xlNone
         .Offset(1).Borders.LineStyle = xlNone
         .BorderAround 1, xlThin, xlColorIndexAutomatic, -4123
         .Borders(xlInsideHorizontal).ColorIndex = -4105
         .Borders(xlInsideVertical).ColorIndex = -4105
    End With
  End With
End If
Cancel = -1
End Sub
 
Laatst bewerkt:
Ik denk dat het met onderstaande net allemaal wat beter loopt (bij geen gegevens, juiste gegevens van de dubbelklik van kolom F, de cancel=true, de kleurtjes)
Klik om te vergroten...

Denk ik ook. Maar was al een beetje laat voor mijn doen:d
 
Heren ik vind het er enorm gelikt uitzien en het werkt met een snelle blik nog fantastisch ook.
Volgens ben ik er. Zal morgen verder kijken maar eerste indruk subliem.

Superthanks, ook de onderlinge samenwerking/wedijver. Heerlijk.
Meld mij gauw met nog een aanpassing of afmelden vraag

Frank
 
Qua opmaak is dit iets beter bij geen gegevens in Blad2 (geen borders op eerste rij).
Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim ar As Range
If Not Intersect(Target, Range("F5:U5")) Is Nothing Then
Application.ScreenUpdating = False
    With Blad2
    .Cells.Clear
        For Each ar In Range("A6:U46,A55:U83").Areas
            With ar
                .AutoFilter Target.Column, 1
                .Offset(1).Resize(, 3).Copy Blad2.Cells(Rows.Count, 1).End(xlUp).Offset(IIf(IsEmpty(Blad2.[a1]), 0, 1))
                .AutoFilter
            End With
        Next ar
    With .Cells(1).CurrentRegion
        .Interior.ColorIndex = xlNone
        .Parent.Cells.Borders.LineStyle = xlNone
      If Not IsEmpty(.Parent.[a1]) Then
        .Sort .Parent.[a1]
        .BorderAround 1, xlThin, xlColorIndexAutomatic, -4123
        .Borders(xlInsideHorizontal).ColorIndex = -4105
        .Borders(xlInsideVertical).ColorIndex = -4105
      End If
    End With
  End With
End If
Cancel = -1
End Sub
 
Komt foutmelding tegen van samengevoegde cellen

Beste Harry,

Werkt super echter als ik er het complete bestand pak, zijn extra kolommen die ik weggelaten had, krijg ik de foutmelding U kunt niet een deel van een samengevoegde cel wijzigen
Kan dit oplossen door eerst de kolommen W t/m Z te verwijderen voordat jouw regels beginnen of heb je hier ook een oplossing voor?
Als je op 4 aug op de D dubbelklikt zie je de foutmelding komen echter bij de D van 3 augustus doet hij het wel goed????

Zie bijlage heb hem in moeten pakken. kreeg melding dat maar 100 Kb mocht zijn zat er net boven.
Snap niet want ik heb in verleden bestanden met meer Kb's bijgevoegd bij vragen.

alvast bedankt,

Frank
 

Bijlagen

Zonder ernaar gekeken te hebben zou ik adviseren om de samengevoegde cellen te verwijderen en de tekst over de selectie te centreren.
 
Gelukt, nu de lijntjes nog

Is gelukt Harry,

Ik verwijder nu wat kolommen (kolommen niet echt noodzakelijk) en unmerge een paar cellen.
Het ging fout als er maar weinig mensen een 1-tje hadden, dan deden de onderste samengevoegde cellen mee en dat vindt de macro niet leuk.
Dit is opgelost.
Echter zoals je ziet heb ik nu 2 tabbladen/bestanden. Het werkt fantastisch maar als ik vanuit het 2e tabblad hetzelfde doe door dubbelklik gaan de lijntjes weg bij de een en komen bij de ander te staan die ik net uitgevoerd heb.
Hoe behouden ze nu allebei de lijntjes?
De beide tabbladen kan ik nu onafhankelijk van elkaar gebruiken wat ook goed is. Krijg niet op dezelfde momenten deze bestandjes aangeleverd.
Nogmaals ik weet dat het niet de mooiste bestanden zijn ( met name met de groene lijnen e.d.) maar het zijn niet mijn opzets. Ik krijg ze zo aangeleverd.
Maar Harry dank zij jou ben ik al een heel eind.
De lijntjes nog en ik ben er.
Eventuele fine-tuning lukt dan wel.
Alvast bedankt,

Frank
 

Bijlagen

Dit is de boosdoener
Code: 
 [COLOR="#FF0000"].Parent[/COLOR].Cells.Borders.LineStyle = xlNone

Als een bestand te groot is om te plaatsen kan je het ook opslaan als .xlsb. (niet iedereen gebruikt Winrar)
 

Bijlagen

Bedankt voor de tip vwb toevoegen bestandstype.

Rest mij nog 1 verzoek en dan ga ik echt stoppen met mijn vragen over dit onderwerp. Ik ben jullie meer dan erkentelijk.
Ik dubbelklik dus op een D, A of N van een bewuste dag. Hoe krijg ik nu deze Letter waar ik op geklikt heb ook op het tabblad UZK in cel F7?
en in cel F8 de bijbehorende dagnaam en in F9 de bijbehorende datum waar het over gaat.

Dus ik dubbelklik op de D van Dinsdag 9-8-2016 hoe krijg ik deze 3 gegevens ook op het tabblad UZK.

Deze gegevens hoeven enkel uit het tabblad FLEX te komen

Thanks voor de oplossing alvast en dan ga ik dit onderwerp sluiten................................. hoop ik :thumb: :o
 
Laatste aanpassing/toevoeging

Wie redt mij met mijn laatste verzoek van gisteren, 6 aug, 15:11 uur?
Rest mij nog 1 verzoek en dan ga ik echt stoppen met mijn vragen over dit onderwerp. Ik ben jullie meer dan erkentelijk.
Ik dubbelklik dus op een D, A of N van een bewuste dag. Hoe krijg ik nu deze Letter waar ik op geklikt heb ook op het tabblad UZK in cel F7?
en in cel F8 de bijbehorende dagnaam en in F9 de bijbehorende datum waar het over gaat.

Dus ik dubbelklik op de D van Dinsdag 9-8-2016 hoe krijg ik deze 3 gegevens ook op het tabblad UZK.

Deze gegevens hoeven enkel uit het tabblad FLEX te komen

thanks voor de reactie(s),

Frank
 

Bijlagen

Werk die samengevoegde cellen weg en centreer de tekst over de selectie zoals eerder vermeld.
Code: 
End With
[COLOR=#0000FF]    .Range("f7").Resize(, 3) = Array(Target.Value, Target.Offset(-2, IIf(Target.Column = 6, 0, -(Target.Column + 2) Mod 3)), Format(Target.Offset(-1, IIf(Target.Column = 6, 0, -(Target.Column + 2) Mod 3)), "dd-mm-yyyy"))[/COLOR]
[COLOR=#0000FF]    .Columns.AutoFit[/COLOR]
  End With
End If
Cancel = -1
 
Yep ben er bijna. Volgorde anders a.u.b?

Bedankt Harry,

De samengevoegde cellen worden unmerged (A81 t/m A84 en A86 t/m A89) zodat ze geen kwaad meer doen in de macro.
Ze hebben voor de uitvoering van het geheel geen betekenis voor mij dus ik dacht huppekee wat kolommen weg en de bewuste cellen unmergen en goed genoeg.
De beide bestanden krijg ik elke dag aangeleverd. Aantallen kunnen per shift veranderen. Tabblad is niet geldig voor een hele week.
Ik kopieer de bewuste tabbladen 2x per dag ochtend en middag, naar mijn bestand en bewuste tabbladen en draai de dubbelklik macro.
Print het uit en de tabbladen worden gewist voor de volgende sessie. ( zie bijlage )

Echter jouw oplossing staat nu naast elkaar ik hoop dat het ook onder elkaar kan/mag/lukt. :thumb: Cel F7 = D,A of N, F8 = dagnaam en F9 = datum, datumnotatie aangepast naar dd-mmm :thumb:
nu is het F7 G7 en H7 :o

Dan is het echt sloes en tot een volgende keer.

Alvast super bedankt voor de hulp en geduld voor deze topic dikke duimen:thumb:

Frank
 

Bijlagen

Kleine aanpassing dan maar.
Code: 
.Range("f7").Resize(3) = application.transpose(Array(Target.Value, Target.Offset(-2, IIf(Target.Column = 6, 0, -(Target.Column + 2) Mod 3)), Format(Target.Offset(-1, IIf(Target.Column = 6, 0, -(Target.Column + 2) Mod 3)), "dd-mmm")))
 
SUPER, SUPER, SUPER.
Ben een behoorlijke dosis jaloers op je kennis en kunde.
Fantastisch.
Vind dit niet in de boeken die ik heb.

Welk boek is aan te raden om dit te vinden?
Ik heb mijn leer jezelf professional VBA maar vind dit niet hierin.

Topic sluit.

Nogmaals Super bedankt weer Harry.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan