Gegevens uit de cellen halen

Status
Niet open voor verdere reacties.

Programhash

Nieuwe gebruiker
Lid geworden
21 okt 2008
Berichten
2
Hallo, ik ben nieuw hier en ook redelijk nieuw bij VBA. Ik ben nu bezig met iets te maken. Ik heb 3 werkbladen en de gegevens dat ik nodig heb staan in de 2 eerste werkbladen.In het laatste werkblad is er een voorgemaakte tabel waar de data dat ik moet zoeken in moet gekopieert worden op de juist plaats, maar het lukt niet. In het derde werkblad staat dus een datum dat ik al in een variabele heb gezet maar nu moet ik die zelfde datum ook vinden in de eerste twee werkbladen. De datums staan in de eerste rij en als ik de datum gevonden heb dan moet ik in die kolom al de gegevens bekijken en controleren waar het moet staan in mijn derde werkblad. Want het zijn niet alleen de gegevens in die ene kolom maar ook iedere keer de namen van de personen die bij die gegevens horen moeten erin gekopieerd worden. Die namen staan iedere keer in de eerste kolom van de twee eerste werkbladen en moeten naar de eerste kolom komen in het 3e werkblad.

Kan iemand mij helpen?

Mijn code blokkeert bij deze regel
Code:
dteDatumControleren = CDate(rngCelcontroleren.Value)

maar dan wel maar bij de tweede loop.

Weet iemand wat mijn fout is?
Dit is mijn volledige code:
Code:
Private Sub Lijst_ZAAL1_Click()
' ++++++++++++++++++++++++++++++++++++Informatie zoeken++++++++++++++++++++++++++++++++++++++++++++++++++++
' In cel J1 wordt het nummer van de zaal gezet die verantwoordelijk is voor acute patiënten
    ' declareren van variabelen
    Dim dteGezochteDatum, dteDatumControleren As Date
        Dim intMonth As Integer
    Dim intGezochteDatum As Integer
    Dim rngCelcontroleren As Range
        
    ' Kijken over welke datum het gaat
    dteGezochteDatum = Worksheets("front").[A1].Value
        
    ' In welk werkblad staat de informatie?
        ' Over welke maand gaat het?
        intMonth = Month(dteGezochteDatum)
        ' Naar juiste werkblad gaan
        If intMonth >= 1 And intMonth <= 5 Then
            Sheets("jan-mei").Select
                ' Zaalnummer vvan de acute patiënten zoeken en in cel J1 zetten
                Set rngCelcontroleren = Range("C1")
 
                'Could be an infinite loop
                Do
                    dteDatumControleren = rngCelcontroleren.Value
                    Set rngCelcontroleren = rngCelcontroleren.Offset(0, 1)
                Loop Until dteGezochteDatum = dteDatumControleren
 
                Set rngCelcontroleren = rngCelcontroleren.Offset(2, 0)
                rngCelcontroleren.Copy Worksheets("front").Range("J1")

        Else
            Sheets("jun-dec").Select
                ' Zaalnummer vvan de acute patiënten zoeken en in cel J1 zetten
                Set rngCelcontroleren = Range("C1")
 
                'Could be an infinite loop
                Do
                    dteDatumControleren = CDate(rngCelcontroleren.Value)
                    Set rngCelcontroleren = rngCelcontroleren.Offset(0, 1)
                Loop Until dteGezochteDatum = dteDatumControleren
 
                Set rngCelcontroleren = rngCelcontroleren.Offset(2, 0)
                rngCelcontroleren.Copy Worksheets("front").Range("J1")

        End If
        

End Sub

Ik heb ook nog een alternatieve code voor de LOOP-code:

Code:
    'Variable for last used column
    Dim LastColumn As Long 
     
     'Variable (object) for individual cells in search range
    Dim cel As Range 
     
     'for testing
    dteGezochteDatum = Range("A1") 
     
     'Get last Column to search
    LastColumn = Range("IV1").End(xlToLeft).Column 
     
     'Set as C1 to last column used, row 1
    Set rngCelcontroleren = Range(Cells(1, 3).Address, Cells(1, LastColumn).Address) 
     
     'Use "For Each"
    For Each cel In rngCelcontroleren 
         'Test if date found
        If dteGezochteDatum = cel.Value Then 
             'Yes. Continue with Copy
            Exit For 
        ElseIf cel.Column = LastColumn Then 
             'Test if whole range searched
            LastColumn = MsgBox("Date not found", vbInformation) 
             'Destroy object
            Set cel = Nothing 
             'Bail
            Exit Sub 
        End If 
    Next cel 
    cel.Offset(2, 0).Copy Worksheets("front").Range("J1") 
     'Destroy object
    Set cel = Nothing


Bedankt
 
Begin bij het begin met VBA en niet meteen met code op nivo 7.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan