Pagina 1 van de 2 12 LaatsteLaatste
Resultaten 1 tot 10 van de 13

Onderwerp: gegevens ophalen van ander werkblad, invullen en terugzette

  1. #1
    Geregistreerd
    Jul 2006
    Berichten
    300

    Standaard gegevens ophalen van ander werkblad, invullen en terugzette

    Beste excellers,

    Deze topic is eigenlijk een vervolg op deze http://www.worksheet.nl/forumexcel/s...ad.php?t=63933.
    Nu het klassement zo goed als rond is, zou ik graag het volgende bekomen: OP mijn invulblad wil ik de gegevens halen uit het werkblad competitie.(zie vb) Als ik dit heb wil ik handmatig de uitslagen invullen, en nadien terugzetten naar het tabblad competitie (liefst op de juiste plaats.) waar ik het nadien terug kan ophalen. Ik probeer te verduidelijken, Ik haal de gegevens uit tab competitie, vul resultaat in, gegevens in competitie moeten nu blijven vaststaan en mogen niet meer veranderen. Als ik nadien de uitslag van een bepaalde speeldag terug wil opvragen, zou dit geen probleem meer mogen zijn. Nu krijg ik 0 als er nog geen uitslagen vermeld zijn in tab competitie. Ik heb echt geen idee hoe ik hier aan moet beginnen. Als iemand van de experts zich geroepen voelt om een voorzetje te geven (vba?) wil ik graag afwerken. Naar gewoonte zal mijn vraagstelling waarschijnlijk weer onduidelijk zijn, maar ik heb geen betere. Sorry.
    Alvast bedankt en hopelijk tot één dezer.

    jos

    ps.
    ook excuses mocht de link hierboven niet werken naar behoren( heb geen idee hoe ik dit moet verhelpen)
    Bijgevoegde Bestanden Bijgevoegde Bestanden

  2. # ADS
    Geregistreerd
    Always
    Berichten
    Many
     
  3. #2
    Geregistreerd
    Mar 2008
    Locatie
    Bachten de kupe, W-Vl, Belgie
    Berichten
    10.257

    Standaard

    in Thisworkbook via workbook_open-event maak je dat het werkblad "invulblad" beveiligd is maar dat de macros toch nog toegang hebben ondanks de beveiligingen.
    Dat werkblad is beveiligd en alle cellen in dat gebied zijn vergrendeld behalve die cellen waar je de doelpunten invult en (soms) die cel waar je de competitiedag kiest.
    Als je start, kan je dus willekeurig een competitiedag kiezen, dusnoods nog een 2e keer etc. Pas op het ogenblik dat je een uitslag intikt, wordt C2(je competitiedag) ook vergrendeld en die komt pas terug vrij als je je uitslag teruggeschreven hebt naar "competitie" via die groene knop.
    Er wordt steeds van uitgegegaan dat er een blok van 8 rijen bij 5 kolommen heen en weer tussen competitie en invulblad wordt gekopieerd.
    Bijgevoegde Bestanden Bijgevoegde Bestanden
    ʎɐqǝ uo pɹɐoqʎǝʞ ɐ ʎnq ı ǝɯıʇ ʇsɐן ǝɥʇ sı sıɥʇ

  4. #3
    Geregistreerd
    Jul 2006
    Berichten
    300

    Standaard

    Beste Bart,

    Zoals steeds was je er weer als de kippen bij. Ik heb nog niet getest, maar ga dit vanavond zeker doen. Mijn eerste indruk doet vermoeden dat het weer op en top af zal zijn. Als dit idd zo is, kan ik ineens beginnen om de 2 topics samen te voegen en zo tot een redelijk definitief eindresultaat te komen. Her en der nog wat opmaak, en wat kleine aanpassingen en dan kan de competitie starten.
    Alvast mijn dank en ik laat u graag mijn bevindingen weten.

    Jos

  5. #4
    Geregistreerd
    Jul 2006
    Berichten
    300

    Standaard

    Ik heb nu zo min of meer een kantklare oplossing gekregen, maar wanneer ik deze allemaal in één deftige sheet wil zetten, duikt er telkens een foutmelding op.
    Waarschijnlijk ben ik onderweg iets vergeten toe te voegen of heb iets teveel toegevoegd, maar het werkt niet naar behoren. (ter info)De commandbutton die Bsalv toevoegde in zijn laatste bijdrage is nu veranderd van kleur. Het lichtgroene werd donkerrood en is terug te vinden in het logo van de jupiler-league. Als dit alles nu zou werken, kan ik ook de laatste aanpassingen doen in het klassement, zodat de sheet klaar is en de competitie kan beginnen.
    Hier het voorbeeld zoals het er tot nu toe uitziet.

    jos
    Bijgevoegde Bestanden Bijgevoegde Bestanden

  6. #5
    Geregistreerd
    Mar 2008
    Locatie
    Bachten de kupe, W-Vl, Belgie
    Berichten
    10.257

    Standaard

    ik krijg hem niet gerard binnen de 195 kb-beperking van deze site
    dus krijg je hem op deze manier, dit is de module voor blad1
    misschien is ook 1 en ander misgegaan in competitie daarom hier in bijlage dat blad competitie
    Code:
    Option Explicit
    Public C2V     As Boolean
    Public ApplBits As Integer
    
    Private Sub Worksheet_Change(ByVal Target As Range)
      Dim lrij As Long, c As Range, d As Range, AP As Integer
    
      If Not Intersect(Target, Range("E4:E11,G4:G11")) Is Nothing Then  'verander je de uitslag van een match, dan mag je niet van speeldag veranderen zonder te saven
        ActiveSheet.Unprotect
        Range("C2").Locked = True                              'speeldag is niet meer te wijzigen tenzij na opslaan
        ActiveSheet.Protect userinterfaceonly:=True
      End If
    
      If Not Intersect(Target, Range("C2")) Is Nothing Then    'verander je de speeldag, dan kopieer je alle gekende gegevens vanuit competitie en kleur je alles volgens clubkleuren
        lrij = WorksheetFunction.Match(Range("C2").Value, Sheets("competitie").Columns("B"), 0)  'rijnummer met 1e match van die speeldag
        If lrij = 0 Then MsgBox "die competitiedag niet gevonden !!!! ": Exit Sub  'rijnummer niet gevonden
    
        'eerst wat huishoudelijke taken zodat na het beeindigen van de macro alles in dezelfde staat staat
        AppliBits True                                         'even kijken hoe 1 en ander staat
        AP = ApplBits                                          'gegevens naar variabele schrijven
        On Error Resume Next                                   'doorgaan bij eventuele fouten
        With Application
          .ScreenUpdating = False                              'scherm bevriezen
          .EnableEvents = False                                'events tijdelijk uitzetten
          .Calculation = xlCalculationManual
        End With
        ActiveSheet.Unprotect                                  'beveiliging van het blad afgooien
    
        Range("D4").Resize(8, 5).Value = Sheets("competitie").Range("E" & lrij).Resize(8, 5).Value  'neem die blok van 8 rijen bij 5 kolommen klakkeloos over
    
        InvullenRooster                                        'dat rooster met voetbaluitslagen aanvullen
        kleuren
        AppliBits False                                        'huishoudelijke taken terug rechtzetten en/of controleren
        EventsOn
        Application.Calculation = xlCalculationAutomatic
    
        If Err.Number <> 0 Then MsgBox "er is net iets misgegaan in het programma ????"
        On Error GoTo 0
      End If
    
    End Sub
    Sub kleuren()
      Dim c As Range, d As Range
      Application.Calculation = xlCalculationAutomatic
      For Each c In Range("d4:d11,h4:h11,l2:l17,de2:de17").Cells  'bijkleuren van alle clubs in hun kleuren
        Set d = Nothing
        Set d = Sheets("blad1").Range("de2:de17").Find(c.Value)
        If Not d Is Nothing Then
          c.Interior.ColorIndex = d.Interior.ColorIndex
          c.Font.ColorIndex = d.Font.ColorIndex
          If c.Column = Columns("L").Column Then
            d.Copy
            c.PasteSpecial xlPasteComments
          End If
        End If
      Next
    End Sub
    
    
    Private Sub CommandButton1_Click()
      Dim lrij As Long, AP As Integer
      lrij = WorksheetFunction.Match(Range("C2").Value, Sheets("competitie").Columns("B"), 0)  'rijnummer met 1e match van die speeldag
      If lrij = 0 Then MsgBox "die competitiedag niet gevonden !!!! Kan niet wegschrijven": Exit Sub  'rijnummer niet gevonden
      AppliBits True                                           'even kijken hoe 1 en ander staat
      AP = ApplBits                                            'gegevens naar variabele schrijven
      With Application
        .ScreenUpdating = False                                'scherm bevriezen
        .EnableEvents = False                                  'events tijdelijk uitzetten
        .Calculation = xlCalculationManual
      End With
      ActiveSheet.Unprotect                                    'beveiliging van het blad afgooien
      Sheets("competitie").Range("E" & lrij).Resize(8, 5).Value = Range("D4").Resize(8, 5).Value  'neem die blok van 8 rijen bij 5 kolommen klakkeloos over
      InvullenRooster
      kleuren
      AppliBits False                                          'even kijken hoe 1 en ander staat
      ActiveSheet.Unprotect
      Range("C2").Locked = False                               'speeldag is weer te wijzigen
      ActiveSheet.Protect
      EventsOn
      Application.Calculation = xlCalculationAutomatic
    End Sub
    
    Sub EventsOn()
      Range("B21") = ""
      Application.EnableEvents = True
    End Sub
    
    Sub EventsOFF()
      Application.EnableEvents = False
      ActiveSheet.Unprotect
      If C2V = False Then Range("C2").Locked = True            'speeldag is niet meer te wijzigen tenzij na opslaan
      ActiveSheet.Protect
      Range("B21") = "De events zijn uitgeschakeld, macros zijn inactief"
    End Sub
    
    Sub KopieerEenSchildje()
      Range("N17").Copy
      Range("N15").PasteSpecial xlPasteComments
    End Sub
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      If Target.Address = "$C$2" And Target.Locked Then MsgBox "Je kan de competitiedag niet wijzigen vooraleer je deze uitslagen weggeschreven hebt !!!!!"
    End Sub
    
    Sub InvullenRooster(Optional x)
      Dim Thuis As String, Uit As String, c As Range, d As Range, FirstAddress As String, b As Boolean
      If ActiveSheet.Name <> Sheets("blad1").Name Then MsgBox "fout": Exit Sub  'je moet in dit werkblad staan, anders gaat het fout
    
      For Each c In Range("W2:BR17")                           'ga alle cellen van dat rooster af
        If Cells(1, c.Column).MergeArea.Cells(1, 1).Column = c.Column Then  'bovenste rij zijn samengestelde cellen, is het de 1e cel van die cellen ?
          Thuis = Cells(c.Row, "V").Value                      'dit is de thuisploeg
          Uit = Cells(1, c.Column).Value                       'dit is de uitploeg
          If Thuis <> Uit Then
            b = True                                           'verder zoeken naar de competitiematch
            With Sheets("competitie").Columns("E")             'zoek de thuisploeg in deze kolom
              Set d = .Find(Thuis, LookIn:=xlValues)
              If Not d Is Nothing Then
                FirstAddress = d.Address
                Do
                  If d.Offset(, 4).Value = Uit Then            'juiste uitploeg ?
                    b = False                                  'niet meer verder zoeken, match gevonden
                    If d.Offset(, 1) <> "" And d.Offset(, 3) <> "" Then  'beide gegevens (doelpunten ingevuld)
                      c.Value = d.Offset(, 1): c.Offset(, 2) = d.Offset(, 3)
                    Else
                      c.Value = Empty: c.Offset(, 2) = Empty
                    End If
                  End If
                  Set d = .FindNext(d)
                Loop While Not d Is Nothing And d.Address <> FirstAddress And b
              End If
              If b = True Then MsgBox "de match " & vbLf & Thuis & " - " & Uit & vbLf & " staat niet in je werkblad ""competitie"""
            End With
          End If
        End If
      Next
    End Sub
    
    Sub AppliBits(RW As Boolean)
    'verzamel enkele bitjes zodat je de toestand ervan kan onthouden of terugzetten
    'RW=1 = bitjes verzamelen, RW=0 bitjes terugzetten volgens gegevens in public variabele ApplBits
      Dim b As Boolean, i As Integer, j As Integer
      With Application
        If RW Then
          ApplBits = 0
          For i = 0 To 3
            Select Case i
              Case 0: b = .EnableEvents
              Case 1: b = .ScreenUpdating
              Case 2: b = (.Calculation = xlCalculationAutomatic)
              Case 3: b = ActiveSheet.ProtectContents
            End Select
            ApplBits = ApplBits + (-b) * WorksheetFunction.Power(2, i)
          Next
        Else
          For i = 0 To 3
            j = Int((ApplBits Mod WorksheetFunction.Power(2, i + 1)) / WorksheetFunction.Power(2, i))
            b = j = 1
            Select Case i
              Case 0: .EnableEvents = b
              Case 1: .ScreenUpdating = b
              Case 2: .Calculation = IIf(b, xlCalculationAutomatic, xlCalculationManual)
              Case 3:
                If b Then
                  ActiveSheet.Protect userinterfaceonly:=True
                Else
                  ActiveSheet.Unprotect
                End If
            End Select
          Next
        End If
      End With
    End Sub
    Bijgevoegde Bestanden Bijgevoegde Bestanden
    ʎɐqǝ uo pɹɐoqʎǝʞ ɐ ʎnq ı ǝɯıʇ ʇsɐן ǝɥʇ sı sıɥʇ

  7. #6
    Geregistreerd
    Jul 2006
    Berichten
    300

    Standaard

    Beste Bart,

    Ik heb uw nieuwe bijdrage in een nieuwe map geplaatst.
    Ik heb alle andere tabbladen effe verwijderd en zie dat er nog enkele kleinigheidjes niet werken naar behoren.
    Heb zelf al wat proberen aan te passen, maar dit is net als latijn leren aan een chinees. Enfin, ik hoop dat jullie de bomen nog zien en er toch nog een oplossing uit de bus komt. Ik blijf ook oefenen en misschien.....
    groetjes

    Jos
    Bijgevoegde Bestanden Bijgevoegde Bestanden

  8. #7
    Geregistreerd
    Mar 2008
    Locatie
    Bachten de kupe, W-Vl, Belgie
    Berichten
    10.257

    Standaard

    hoop dat het zo beter is.
    Begrijp je ongeveer hoe het werkt ?
    Het is dus belangrijk dat het werkblad "blad1" beveiligd is en dat cel C2 vergrendeld van zodra er een match gewijzigd wordt.
    Moest het toch nog een keer alles stil staan, probeer de boel weer op gang te krijgen met die macro eventsON.
    Bijgevoegde Bestanden Bijgevoegde Bestanden
    ʎɐqǝ uo pɹɐoqʎǝʞ ɐ ʎnq ı ǝɯıʇ ʇsɐן ǝɥʇ sı sıɥʇ

  9. #8
    Geregistreerd
    Jul 2006
    Berichten
    300

    Standaard

    Met een groot woord van dank aan vooral Bart denk ik dat mijn kalender voor de nieuwe Belgische voetbalcompetitie 2010-2011 klaar is. Hier en daar nog wat opmaak en dan zou hij het moeten doen. Ik zou deze kalender graag posten, zodat ook jullie er gebruik van kunnen maken, maar zelfs gezipt of gerard is hij groter dan de hier toegelaten bestandsgrootte. Weet iemand hoe ik dit moet oplossen of kan dit via één van de moderators ? Graag advies.

    Jos

  10. #9
    Geregistreerd
    Mar 2008
    Locatie
    Bachten de kupe, W-Vl, Belgie
    Berichten
    10.257

    Standaard

    even een moderator aanspreken zou moeten volstaan
    ʎɐqǝ uo pɹɐoqʎǝʞ ɐ ʎnq ı ǝɯıʇ ʇsɐן ǝɥʇ sı sıɥʇ

  11. #10
    Geregistreerd
    Nov 2005
    Locatie
    Blokker Nederland
    Berichten
    4.879

    Standaard

    2 oplossingen:

    1. Je gebruikt WinRar en verdeel je file in meerdere Rar bestanden
      hier kun je de grote aangeven.
    2. Of je stuurt de file naar Me!
    Suc6

    druk op F1 en lees ! En zie wat de moeder van de meeste oplossingen is.
    en Worksheet.nl is de dochter

    Moderator www.worksheet.nl / mr.magoo@worksheet.nl

Gelijkwaardige Onderwerpen

  1. Ophalen celinhoud ander werkblad
    Door beeblebr0xx in forum Afgehandelde vragen
    Reacties: 3
    Laatste Bericht: 09-09-11, 14:29
  2. gevens ophalen uit ander werkblad
    Door cpl_c in forum Afgehandelde vragen
    Reacties: 2
    Laatste Bericht: 05-04-11, 14:32
  3. Gegevens ophalen ander werkblad
    Door Robinho in forum Afgehandelde vragen
    Reacties: 2
    Laatste Bericht: 10-11-10, 08:34
  4. Nummer uit ander werkblad ophalen
    Door RuudAdam in forum Afgehandelde vragen
    Reacties: 2
    Laatste Bericht: 13-10-10, 12:09
  5. Gegevens ophalen uit een ander werkblad
    Door excie in forum Afgehandelde vragen
    Reacties: 1
    Laatste Bericht: 17-10-06, 20:28

Forum Rechten

  • Je mag geen nieuwe onderwerpen plaatsen
  • Je mag geen reacties plaatsen
  • Je mag geen bijlagen toevoegen
  • Je mag jouw berichten niet wijzigen
  •