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

Inkorten VBA code

Status
Niet open voor verdere reacties.
N

N12047

Gebruiker
Lid geworden
27 aug 2015
Berichten
56
Hallo allen,

Graag had ik van jullie een beetje hulp.

Onderstaande code werkt naar alle tevredenheid maar is wel lang en onoverzichtelijk.
Maar ja, dat krijg je dan ook als je maar een klein, klein beetje kennis hebt van VBA.
De code doet niets anders dan wat data copieren van de ene sheet naar de andere sheet en dan ook nog naar een bepaalde regel als er een bepaalde selectie gemaakt wordt. Hier wordt dan weer een grafiek van gemaakt.

Mijn kennis van VBA is dusdanig dat het mij niet lukt om dit in te korten.
Deze code moet ik voor 3 jaar doen, dus 2013, 2014 en 2015 en in de toekomst 2016 en verder.
Nu loop ik tegen beperkingen aan, als de code te lang wordt dan krijg ik een melding: Compile error. Procedure too large. :evil::evil:

Nu is mijn vraag:

Kunnen jullie mij helpen om deze code in te korten zodat ik wel meerdere jaren (en dus ook andere selecties) kan doen?

Een voorbeeldje posten zou erg makkelijk zijn maar mijn bestand is bijna 10 Mb en om hier een voorbeeld van te maken zou mij een halve dag werk bezorgen. Maar als het moet, moet het en probeer ik het te maken.

Ik ben in het bezit van Excel 2007 (engelse versie)

Alvast hartelijk bedank dat je dit gelezen hebt en voor de hulp.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("D8")) Is Nothing Then Exit Sub
    If Target.Count < 1 Then Exit Sub
    If Range("K6").Value = "AB02" And Range("K8").Value = "2015" And Range("K9").Value = "Jan" Or Range("K9").Value = "jan" Then
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("C41") = ActiveWorkbook.Sheets("Data").Range("D8")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("D41") = ActiveWorkbook.Sheets("Data").Range("D9")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("E41") = ActiveWorkbook.Sheets("Data").Range("D10")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("F41") = ActiveWorkbook.Sheets("Data").Range("D11")
    End If

    If Intersect(Target, Range("D8")) Is Nothing Then Exit Sub
    If Target.Count < 1 Then Exit Sub
    If Range("K6").Value = "AB02" And Range("K8").Value = "2015" And Range("K9").Value = "Feb" Or Range("K9").Value = "feb" Then
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("C42") = ActiveWorkbook.Sheets("Data").Range("D8")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("D42") = ActiveWorkbook.Sheets("Data").Range("D9")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("E42") = ActiveWorkbook.Sheets("Data").Range("D10")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("F42") = ActiveWorkbook.Sheets("Data").Range("D11")
    End If

    If Intersect(Target, Range("D8")) Is Nothing Then Exit Sub
    If Target.Count < 1 Then Exit Sub
    If Range("K6").Value = "AB02" And Range("K8").Value = "2015" And Range("K9").Value = "Mar" Or Range("K9").Value = "mar" Then
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("C43") = ActiveWorkbook.Sheets("Data").Range("D8")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("D43") = ActiveWorkbook.Sheets("Data").Range("D9")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("E43") = ActiveWorkbook.Sheets("Data").Range("D10")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("F43") = ActiveWorkbook.Sheets("Data").Range("D11")
    End If

    If Intersect(Target, Range("D8")) Is Nothing Then Exit Sub
    If Target.Count < 1 Then Exit Sub
    If Range("K6").Value = "AB02" And Range("K8").Value = "2015" And Range("K9").Value = "Apr" Or Range("K9").Value = "apr" Then
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("C44") = ActiveWorkbook.Sheets("Data").Range("D8")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("D44") = ActiveWorkbook.Sheets("Data").Range("D9")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("E44") = ActiveWorkbook.Sheets("Data").Range("D10")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("F44") = ActiveWorkbook.Sheets("Data").Range("D11")
    End If

    If Intersect(Target, Range("D8")) Is Nothing Then Exit Sub
    If Target.Count < 1 Then Exit Sub
    If Range("K6").Value = "AB02" And Range("K8").Value = "2015" And Range("K9").Value = "May" Or Range("K9").Value = "may" Then
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("C45") = ActiveWorkbook.Sheets("Data").Range("D8")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("D45") = ActiveWorkbook.Sheets("Data").Range("D9")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("E45") = ActiveWorkbook.Sheets("Data").Range("D10")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("F45") = ActiveWorkbook.Sheets("Data ").Range("D11")
    End If

    If Intersect(Target, Range("D8")) Is Nothing Then Exit Sub
    If Target.Count < 1 Then Exit Sub
    If Range("K6").Value = "AB02" And Range("K8").Value = "2015" And Range("K9").Value = "Jun" Or Range("K9").Value = "jun" Then
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("C46") = ActiveWorkbook.Sheets("Data").Range("D8")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("D46") = ActiveWorkbook.Sheets("Data").Range("D9")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("E46") = ActiveWorkbook.Sheets("Data").Range("D10")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("F46") = ActiveWorkbook.Sheets("Data").Range("D11")
    End If

    If Intersect(Target, Range("D8")) Is Nothing Then Exit Sub
    If Target.Count < 1 Then Exit Sub
    If Range("K6").Value = "AB02" And Range("K8").Value = "2015" And Range("K9").Value = "Jul" Or Range("K9").Value = "jul" Then
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("C47") = ActiveWorkbook.Sheets("Data").Range("D8")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("D47") = ActiveWorkbook.Sheets("Data").Range("D9")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("E47") = ActiveWorkbook.Sheets("Data").Range("D10")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("F47") = ActiveWorkbook.Sheets("Data").Range("D11")
    End If

    If Intersect(Target, Range("D8")) Is Nothing Then Exit Sub
    If Target.Count < 1 Then Exit Sub
    If Range("K6").Value = "AB02" And Range("K8").Value = "2015" And Range("K9").Value = "Aug" Or Range("K9").Value = "aug" Then
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("C48") = ActiveWorkbook.Sheets("Data").Range("D8")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("D48") = ActiveWorkbook.Sheets("Data").Range("D9")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("E48") = ActiveWorkbook.Sheets("Data").Range("D10")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("F48") = ActiveWorkbook.Sheets("Data").Range("D11")
    End If

    If Intersect(Target, Range("D8")) Is Nothing Then Exit Sub
    If Target.Count < 1 Then Exit Sub
    If Range("K6").Value = "AB02" And Range("K8").Value = "2015" And Range("K9").Value = "Sep" Or Range("K9").Value = "sep" Then
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("C49") = ActiveWorkbook.Sheets("Data").Range("D8")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("D49") = ActiveWorkbook.Sheets("Data").Range("D9")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("E49") = ActiveWorkbook.Sheets("Data").Range("D10")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("F49") = ActiveWorkbook.Sheets("Data").Range("D11")
    End If

    If Intersect(Target, Range("D8")) Is Nothing Then Exit Sub
    If Target.Count < 1 Then Exit Sub
    If Range("K6").Value = "AB02" And Range("K8").Value = "2015" And Range("K9").Value = "Oct" Or Range("K9").Value = "oct" Then
        ActiveWorkbook.Sheets("Overzicht _grafiek").Range("C50") = ActiveWorkbook.Sheets("Data").Range("D8")
        ActiveWorkbook.Sheets("Overzicht _grafiek").Range("D50") = ActiveWorkbook.Sheets("Data").Range("D9")
        ActiveWorkbook.Sheets("Overzicht _grafiek").Range("E50") = ActiveWorkbook.Sheets("Data").Range("D10")
        ActiveWorkbook.Sheets("Overzicht _grafiek").Range("F50") = ActiveWorkbook.Sheets("Data").Range("D11")
    End If

    If Intersect(Target, Range("D8")) Is Nothing Then Exit Sub
    If Target.Count < 1 Then Exit Sub
    If Range("K6").Value = "AB02" And Range("K8").Value = "2015" And Range("K9").Value = "Nov" Or Range("K9").Value = "nov" Then
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("C51") = ActiveWorkbook.Sheets("Data").Range("D8")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("D51") = ActiveWorkbook.Sheets("Data").Range("D9")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("E51") = ActiveWorkbook.Sheets("Data").Range("D10")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("F51") = ActiveWorkbook.Sheets("Data").Range("D11")
    End If

    If Intersect(Target, Range("D8")) Is Nothing Then Exit Sub
    If Target.Count < 1 Then Exit Sub
    If Range("K6").Value = "AB02" And Range("K8").Value = "2015" And Range("K9").Value = "Dec" Or Range("K9").Value = "dec" Then
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("C52") = ActiveWorkbook.Sheets("Data”).Range("D8")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("D52") = ActiveWorkbook.Sheets("Data”).Range("D9")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("E52") = ActiveWorkbook.Sheets("Data”).Range("D10")
        ActiveWorkbook.Sheets("Overzicht_grafiek").Range("F52") = ActiveWorkbook.Sheets("Data”).Range("D11")
    End If
End Sub
 
De fout zal hierdoor komen bij de regels van December: ("Data”)
Zoals je kan zien is de laatste dubbele quote een onjuist teken.
Het moet dus zo zijn: ("Data")

Nu het inkorten. Zonder je werkblad kan ik het niet testen, maar probeer het eens zo:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim CelNo As Integer
    Dim i     As Integer
    Dim x     As Integer
    
    If Intersect(Target, Range("D8")) Is Nothing Or Target.Count < 1 Then Exit Sub
    
    If Range("K6") = "AB02" And Range("K8") = "2015" Then
        With Sheets("Overzicht_grafiek")
            For x = 41 To 52
                For i = 3 To 6
                    .Cells(i, x) = Sheets("Data").Cells(4, i + 5)
                Next i
            Next x
        End With
    End If
End Sub

Dat is vast ook nog wel zodanig aan te passen dat het onafhankelijk van het jaar is.
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    if target.address<>"$D$8" then exit sub 

    If [K6]&[K8]= "AB022015" Then Sheets("Overzicht_grafiek").Range("C40:F40").offset(Application.Match(lcase([K9]), Application.GetCustomListContents(3), 0))=[transpose(data!D8:D11)]
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan