Problemen bij het wegschrijven van records

Status
Niet open voor verdere reacties.
E

Evatar

Gebruiker
Lid geworden
7 jun 2011
Berichten
59
ik heb deze macro aangepast zover ik kon
Code: 
Private Type oRecord
    nCode As Long
    sDag As String
    tAanvTot As Date
    tEindTot As Date
    tTijdTot As Date
    tAanvDet As Date
    tEindDet As Date
End Type
Dim test As Variant

Public Sub VoegSamen()

Dim oWs As Worksheet
Dim oRegel(100000) As oRecord
Dim lMaxRegel As Long
Dim lRegelTeller As Long
Dim lRecordTeller As Long

For Each oWs In ActiveWorkbook.Worksheets           'Doorloop alle werkbladen
    If oWs.Name <> "Totaal" Then                      'Behalve "Totaal"
        lMaxRegel = oWs.Range("F100000").End(xlUp).Row  'Bepaal nummer laatste regel
        With oWs.Range("A1")
            For lRegelTeller = 0 To lMaxRegel       'Doorloop alle regels
                If .Offset(lRegelTeller, 5) <> "" Then                          'Alleen niet lege regels meenemen
                    oRegel(lRecordTeller).nCode = .Offset(lRegelTeller, 0)      'Eerste kolom
                    oRegel(lRecordTeller).sDag = .Offset(lRegelTeller, 1)       'Tweede kolom
                    oRegel(lRecordTeller).tAanvTot = .Offset(lRegelTeller, 2)   'Derde kolom
                    oRegel(lRecordTeller).tEindTot = .Offset(lRegelTeller, 3)   'Vierde kolom
                    oRegel(lRecordTeller).tTijdTot = .Offset(lRegelTeller, 4)   'Vijfde kolom
                    oRegel(lRecordTeller).tAanvDet = .Offset(lRegelTeller, 5)   'Zesde kolom
                    oRegel(lRecordTeller).tEindDet = .Offset(lRegelTeller, 6)   'Zevende kolom
                    lRecordTeller = lRecordTeller + 1   'Ga naar volgdend record
                End If
            Next                                    'Ga naar volgende regel
        End With
    End If
Next                                                'Ga naar volgende werkblad

'Alle gegevens zijn opgehaald nu nog wegschrijven.
lRecordTeller = 0

With Worksheets("Totaal").Range("A2")
    Do While oRegel(lRecordTeller).tAanvDet <> 0
        .Offset(lRecordTeller, 0) = IIf(oRegel(lRecordTeller).nCode = 0, "", oRegel(lRecordTeller).nCode)
        .Offset(lRecordTeller, 1) = IIf(oRegel(lRecordTeller).sDag = "", "", oRegel(lRecordTeller).sDag)
        .Offset(lRecordTeller, 2) = IIf(oRegel(lRecordTeller).tAanvTot = 0, "", Format(oRegel(lRecordTeller).tAanvTot, "hh:mm"))
        .Offset(lRecordTeller, 3) = IIf(oRegel(lRecordTeller).tEindTot = 0, "", Format(oRegel(lRecordTeller).tEindTot, "hh:mm"))
        .Offset(lRecordTeller, 4) = IIf(oRegel(lRecordTeller).tTijdTot = 0, "", Format(oRegel(lRecordTeller).tTijdTot, "hh:mm"))
        .Offset(lRecordTeller, 5) = Format(oRegel(lRecordTeller).tAanvDet, "hh:mm")
        .Offset(lRecordTeller, 6) = Format(oRegel(lRecordTeller).tEindDet, "hh:mm")
        lRecordTeller = lRecordTeller + 1
    Loop
End With
MsgBox "Alle gegevens verzameld en op Totaal blad geschreven.", vbInformation, "Klaar"
End Sub

naar

Code: 
Private Type oRecord
    strFil As String
    dteAanvraag As Date
    dteIngepland As Date
    intWeeknummer As Integer
    strNaam As String
    strKentgf As String
    strGemeente As String
    strOpmerking As String
    strActies As String
    strRegio As String
End Type
Dim test As Variant
Private Sub cmdSamenvoegen_Click()
Dim oWs As Worksheet
Dim oRegel(100000) As oRecord
Dim lMaxRegel As Long
Dim lRegelTeller As Long
Dim lRecordTeller As Long

For Each oWs In ActiveWorkbook.Worksheets           'Doorloop alle werkbladen
    If oWs.Name <> "RPT" Or oWs.Name <> "MD" Or oWs.Name <> "TOT" Then                      'Behalve "TOT", "MD", "RPT"
        lMaxRegel = oWs.Range("F100000").End(xlUp).Row  'Bepaal nummer laatste regel
        With oWs.Range("A3")
            For lRegelTeller = 0 To lMaxRegel       'Doorloop alle regels
                If .Offset(lRegelTeller, 5) <> "" Then                          'Alleen niet lege regels meenemen
                    oRegel(lRecordTeller).strFil = .Offset(lRegelTeller, 0)      'Eerste kolom
                    oRegel(lRecordTeller).dteAanvraag = .Offset(lRegelTeller, 1)       'Tweede kolom
                    oRegel(lRecordTeller).dteIngepland = .Offset(lRegelTeller, 2)   'Derde kolom
                    oRegel(lRecordTeller).intWeeknummer = .Offset(lRegelTeller, 3)   'Vierde kolom
                    oRegel(lRecordTeller).strNaam = .Offset(lRegelTeller, 4)   'Vijfde kolom
                    oRegel(lRecordTeller).strKentgf = .Offset(lRegelTeller, 5)   'Zesde kolom
                    oRegel(lRecordTeller).strGemeente = .Offset(lRegelTeller, 6)   'Zevende kolom
                    oRegel(lRecordTeller).strOpmerking = .Offset(lRegelTeller, 7)   'Achtste kolom
                    oRegel(lRecordTeller).strActies = .Offset(lRegelTeller, 8)   'Negende kolom
                    oRegel(lRecordTeller).strRegio = .Offset(lRegelTeller, 9)   'Tiende kolom
                    lRecordTeller = lRecordTeller + 1   'Ga naar volgdend record
                End If
            Next                                    'Ga naar volgende regel
        End With
    End If
Next                                                'Ga naar volgende werkblad

'Alle gegevens zijn opgehaald nu nog wegschrijven.
lRecordTeller = 0

With Worksheets("TOT").Range("A3")
    Do While oRegel(lRecordTeller).strRegio <> 0
        .Offset(lRecordTeller, 0) = IIf(oRegel(lRecordTeller).strFil = "", "", oRegel(lRecordTeller).strFil)
        .Offset(lRecordTeller, 1) = IIf(oRegel(lRecordTeller).dteAanvraag = 0, "", oRegel(lRecordTeller).dteAanvraag)
        .Offset(lRecordTeller, 2) = IIf(oRegel(lRecordTeller).dteIngepland = 0, "", oRegel(lRecordTeller).dteIngepland)
        .Offset(lRecordTeller, 3) = IIf(oRegel(lRecordTeller).intWeeknummer = 0, "", oRegel(lRecordTeller).intWeeknummer)
        .Offset(lRecordTeller, 4) = IIf(oRegel(lRecordTeller).strNaam = "", "", oRegel(lRecordTeller).strNaam)
        .Offset(lRecordTeller, 5) = IIf(oRegel(lRecordTeller).strKentgf = "", "", oRegel(lRecordTeller).strKentgf)
        .Offset(lRecordTeller, 6) = IIf(oRegel(lRecordTeller).strGemeente = "", "", oRegel(lRecordTeller).strGemeente)
        .Offset(lRecordTeller, 7) = IIf(oRegel(lRecordTeller).strOpmerking = "", "", oRegel(lRecordTeller).strOpmerking)
        .Offset(lRecordTeller, 8) = IIf(oRegel(lRecordTeller).strActies = "", "", oRegel(lRecordTeller).strActies)
        .Offset(lRecordTeller, 9) = IIf(oRegel(lRecordTeller).strRegio = "", "", oRegel(lRecordTeller).strRegio)
        lRecordTeller = lRecordTeller + 1
    Loop
End With
MsgBox "Alle gegevens verzameld en op Totaal blad geschreven.", vbInformation, "Klaar"
End Sub

nu werkt het gedeelte voor weg te schrijven niet meer en ik denk dat het te maken heeft met het "Do While" gedeelte.. en hij kopieert ook gewoon wel de gegevens uit tabblad RPT

Kan iemand me helpen mijn fout recht te zetten?

Alvast bedankt.
 
Laatst bewerkt:
heb het opgelost ondertussen mijn weeknummer was een tekst in Excel heb er dus een string van gemaakt, nu werkt het

edit: heb ook de "Or" naar And veranderd anders neemt hij nog steeds alles mee :-)
 
Laatst bewerkt:
Is dit niet voldoende?

Code: 
Sub VenA()
With Sheets("TOT")
    .Cells(1).CurrentRegion.Offset(1).ClearContents
    For Each sh In Sheets
        If sh.Name <> "RPT" And sh.Name <> "MD" And sh.Name <> "TOT" Then
            lr = sh.Cells(Rows.Count, 1).End(xlUp).Row - 2
            .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lr, 10) = sh.[A3].Resize(lr, 10).Value
         End If
    Next sh
End With
ThisWorkbook.RefreshAll
End Sub
 

Bijlagen

Hmm dat is interessant en vééél korter, kan je even een korte uitleg erbij schrijven wat je waar doet (ik kan macro's aanpassen maar probeer ook bij te leren)
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan