Opgelost Formule te lang

Dit topic is als opgelost gemarkeerd
R

Remco1962

Gebruiker
Lid geworden
25 apr 2023
Berichten
42
Ik heb helaas geen kennis van VBA en kan enkel macro's opnemen in Excel (versie 2016). Nu heb ik een macro opgenomen waarbij de melding wordt gegeven "Compileerfout: De procedure is te groot". Bijgesloten word.docx met de formule in de hoop dat een VBA expert er een aanpassing aan kan doen zodat de formule ingekort wordt en toch dezelfde uitkomst geeft...
 

Bijlagen

  • vba formula.docx
    29,2 KB · Weergaven: 10
Een Excelmacro hoort in een Excelbestand, niet in een Wordbestand van 343 pagina's..
Plaats dus het Excelbestand.
Geef aan wat de beginsituatie is, geef aan wat de eindsituatie moet zijn.
Waarom gebruik je VBA zonder kennis van VBA ?
 
Mijn Excel bevat vertrouwelijke informatie van een klant, daarom vind ik het lastig om het te delen. Waarom ik VBA gebruik zonder daar kennis van te hebben?? Ik gebruik een macro in Excel om een standaard formaat van een klant om te zetten naar een excel formaat waarbij ik het kan inlezen in het erp systeem van MS Dynamics. Ik gebruik daar dus een macro voor en een macro in Excel gebruikt VBA.
 
Opgenomen code moet altijd worden aangepast. Er zit nu heel veel overbodige "rommel" in.
Je kan een voorbeeld van dat bestand plaatsen zonder die vertrouwelijke gegevens.
Geef daarbij ook aan wat het resultaat moet worden.
 
En waarom zit dit stukje
Code: 
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With

er 600.000 keer in? Doet compleet niets.... Behalve de eerste keer dat je het laat uitvoeren. En als je spul wilt opmaken zodat het kan worden geïmporteerd in een ander systeem, moet je zeker geen MergeCells gebruiken.

Je complete macro kan dus worden teruggebracht tot dit:

Code: 
Sub Navios()
' Sneltoets: Ctrl+Shift+N
'
    Sheets("READ IN FILE").Select
    Rows("3:1250").Select
    Selection.Delete Shift:=xlUp
    Range("Tabel1[Nav Code]").Select
    Sheets("COPY TOTAL INQUIRY").Select
    Rows("1:22").Select
    Range("B1").Activate
    Selection.Delete Shift:=xlUp
    Range("B1").Select
    Columns("A:A").ColumnWidth = 7.57
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "X"
    Range("A1").Select
    Selection.Copy
    Range("A2").Select
    ActiveWindow.ScrollRow = 1065
    ActiveWindow.SmallScroll Down:=150
    Range("A2:A1250").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("D:H").Select
    Range("D2").Activate
    Application.CutCopyMode = False
    
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With

    Selection.UnMerge
    Range("E:H,K:P").Select
    Range("K1").Activate
    Selection.Delete Shift:=xlToLeft
    Range("T9").Select
    Columns("D:D").ColumnWidth = 21.57
    Columns("E:E").ColumnWidth = 17.57
    Columns("F:F").ColumnWidth = 21.29
    Columns("G:M").Select
    Selection.ColumnWidth = 20.71
    Columns("F:F").Select
    Selection.Copy
    Columns("G:G").Select
    ActiveSheet.Paste
    Range("H1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "A"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "B"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "C"
    Range("A1:J1").Select
    Selection.AutoFilter
    Rows("2:2").Select
    ActiveWindow.FreezePanes = True
    Range("J9").Select
    ActiveSheet.Range("$A$1:$J$1250").AutoFilter Field:=2, Criteria1:="="
    ActiveWindow.SmallScroll Down:=49
    ActiveWindow.LargeScroll Down:=3
    ActiveWindow.SmallScroll Down:=14
    Rows("18:1250").Select
    Range("A1250").Activate
    Selection.Delete Shift:=xlUp
    Range("D1022").Select
    ActiveSheet.Range("$A$1:$J$1018").AutoFilter Field:=2
    ActiveWindow.ScrollRow = 2
    Range("A2").Select
    ActiveSheet.Range("$A$1:$J$1018").AutoFilter Field:=4, Criteria1:=RGB(250, 250, 210), Operator:=xlFilterCellColor
    ActiveWindow.SmallScroll Down:=169
    Rows("18:1200").Select
    Range("A1200").Activate
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$1:$J$994").AutoFilter Field:=4
    ActiveWindow.ScrollRow = 2
    Range("H3").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(IF(SEARCH(""="",RC[-1])>0,RC[-1],""""),"""")"
    Range("H3").Select
    Selection.Copy
    Range("H4:H1242").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveWindow.ScrollRow = 2
    Columns("F:F").Select
    Selection.Replace What:="=*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Range("I2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=IF(RC[-7]>0,IF(RC[-4]="""",CONCATENATE(""*** DEPARTMENT: "",RC[-7]),CONCATENATE(RC[-5],"" ("",RC[-1],"")"")),"""")"
    Range("I2").Select
    Selection.Copy
    Range("I3").Select
    ActiveWindow.ScrollRow = 1208
    Range("I3:I1250").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveWindow.ScrollRow = 2
    Columns("I:I").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.Replace What:=" ()", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    ActiveWindow.ScrollRow = 2
    Range("A1").Select
    Selection.End(xlDown).Select
    Range("A994:K994").Select
    Selection.ClearContents
    ActiveWindow.ScrollRow = 2
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""","""",RC[-5])"
    Selection.Copy
    Range("G3").Select
    ActiveWindow.ScrollRow = 1208
    Range("G3:G1250").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("P1249").Select
    ActiveWindow.ScrollRow = 2
    Columns("I:I").Select
    Application.CutCopyMode = False
    Selection.Cut
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("READ IN FILE").Select
    Range("Tabel1[Description]").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("COPY TOTAL INQUIRY").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("C2:D993").Select
    Range("D2").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("READ IN FILE").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("COPY TOTAL INQUIRY").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Sheets("READ IN FILE").Select
    Range("A2").Select
    ActiveWorkbook.Save
End Sub

Niet dat je daar de schoonheidsprijs mee gaat winnen...
 
MSdynamics biedt allerlei hulp voor de import van gegevens (ook csv)
 
Dan moet je inderdaad het gewenste formaat weten.
Dat maak verschil tussen MS Dynamics AX, Navision of Business Central.
 
Dank voor jullie input. Momenteel is het proces gaande om naar een laatste versie over te stappen, iets wat waarschijnlijk nog wel ruim een jaar zal duren eer het wordt getest. Tot die tijd probeer ik collega's te helpen door aanvragen van bepaalde klanten om te zetten naar een formaat dat we momenteel wel kunnen inlezen. Ik ben maar een leek en heb mezelf een beetje Excel aangeleerd. Ik krijg vaker antwoorden op mijn vragen die voor mij, vanwege mijn gebrek aan kennis, niet te begrijpen zijn, maar probeer er toch van te leren.
Bijgesloten Excel sheet: ik kopieer de aanvraag van de klant naar het tweede tabblad (Total Copy Inquiry) en heb handelingen verricht om het resultaat te krijgen op het eerste tabblad (Read In File). Alle handelingen opgenomen met een macro, die vervolgens de foutmelding gaf "Compileerfout: De procedure is te groot".
 

Bijlagen

  • HelpMij.xlsm
    227 KB · Weergaven: 8
Bij VBA gaat het niet om formules, maar om code (regels).
Waarschijnlijk krijg je nu de mededeling "procedure onwaarschijnlijk kort'.
Waar komen toch die verschrikkelijke samengevoegde cellen vandaan ?

Code: 
Sub M_snb()
   Blad2.Cells.UnMerge
   Blad2.Columns.Hidden = False
   Blad2.UsedRange.Columns(1).SpecialCells(4).EntireRow.Delete
   Blad2.UsedRange.Columns(5).SpecialCells(2).EntireRow.Delete
 End Sub
 
Dank snb voor je reactie, uitleg en humor 😄. Waarom samengevoegde cellen is mij ook een raadsel, maar zo is het standaard formaat van de klant waarin we alle aanvragen aangeleverd krijgen. Begrijp ik goed dat je een stukje code bijsluit ter vervanging van een gedeelte van de oude code?
 
Ter vervanging van de hele code: verwijder die dus.
Kopieer mijn code in de macrodule van blad2 en laat hem lopen.
 
Maar de code die ik via Excel macro had opgenomen deed veel meer. Het voorbeeld dat ik deelde toont de het tabblad 2, het formaat met (merged cells) zoals ik die ontvang en tabblad 1 waarnaar de gegevens van blad 2 toe worden gekopieerd. Ik heb in de macro bepaalde regels verwijderd, soms teksten samengevoegd, enz. Daarom dacht ik dat er een deel van de lange code die had gedeeld kon worden vervangen met Sub M_snb()
 
Jij weet helemaal niet wat de code doet.
Je hebt hem ook nog niet eens gebruikt.
Gebruik hem of gebruik hem niet.
 
Natuurlijk heb ik hem gebruikt, maar waarschijnlijk niet op de correcte plek gezet. Ik zie heb dan in de macro staan en als ik hem start dan verdwijnen de rijen 1 t/m 22 en zijn de kolommen unmerged.
Maar inmiddels is het duidelijk dat ik hier niet op het forum thuis hoor. Ik heb er te weinig verstand van en irriteer blijkbaar mensen met mijn vragen, gebrek aan basiskennis en onkunde. Ik verontschuldig me daarvoor en me afmelden.
 
Jeetje wat een gevoelige tenen! Zo erg is de (best wel geldige) kritiek toch niet? Jouw opmerkingen wekken ook bij mij de indruk dat je geen idee hebt wat de macro doet.

Sowieso kan ik mij niet voorstellen dat je de opgenomen macro goed hebt bekeken, want ik heb nog nooit een macro gezien met zoveel code, waarvan dus één stukje duizenden keren hetzelfde doet. Die macro heb ik dus voor je geschoond, zodat je alleen de bruikbare werkende code overhoudt, maar heb je die code getest en gebruikt? Geen idee. Heb je mij daarvoor bedankt? Dat al helemaal niet.

Kortom: wél klagen over helpers die (nota bene hun eigen) tijd in jouw probleem steken, maar zelf géén feedback geven over datgene wat je dan aan antwoorden terugkrijgt… Hoeveel zin denk je dat ik dan nog heb om jou verder te helpen?
 
En omdat het jammer zou zijn als je snb's code niet zou gebruiken heb ik deze een beetje uitgebreid:

Departments voorzien van voorlooptekst "*** DEPARTMENT: " en verplaatst naar kolom B.
Kolommen K t/m P verwijderd.
Kolommen E t/m H verwijderd.
Kolom B verplaatst naar kolom G.
Kolom A verwijderd.
Kopregel toegevoegd.

Al met al is de code gekrompen van 10988 regels naar 21 regels, waarschijnlijk kan snb deze nog verder comprimeren ;-)
Code: 
Sub M_snb()
    Blad2.Activate
    Cells.UnMerge
    Columns.Hidden = False
    ActiveSheet.UsedRange.Columns(1).SpecialCells(4).EntireRow.Delete
    ActiveSheet.UsedRange.Columns(5).SpecialCells(2).EntireRow.Delete
    For r = 1 To Range("A1").CurrentRegion.Rows.Count
        If Cells(r, 1) = "G" Then
            Cells(r, 4) = "*** DEPARTMENT: " & Cells(r, 2)
            Cells(r, 2) = ""
        End If
    Next
    Columns("K:P").Delete Shift:=xlToLeft
    Columns("E:H").Delete Shift:=xlToLeft
    Columns("B:B").Cut Destination:=Columns("G:G")
    Columns("A:A").Delete Shift:=xlToLeft
    Rows("1:1").Insert Shift:=xlDown
    Range("A1").Resize(, 9) = Array("Nav Code", "Reference", "Description", "Quantity", "unit", "Pos No", "Purchase Price", "Sales Price", "Supplier")
    ActiveWindow.FreezePanes = False
    Cells.EntireColumn.AutoFit
End Sub
 
@AHulpje

Even algemeen: VBA is object georiënteerd.
Daarom kunnen we in VBA naar ieder object direct verwijzen.
De with .... end with is daarvoor een ongelooflijk goede aanvullling in VBA.
We kunnen daarmee exact aangeven in welk object van een bestand moet gebeuren.
De onhandige beperking van de gebruikersinterface waar iets alleen in het aktieve scherm kan gebeuren hebben we in VBA niet.
Blad2.Acivate (met alle daaraan hangende aktiviteiten: schermverversing, berekeningen, etc) kunnen we daardoor vermijden. Ook aanduidingen als 'activesheet' zijn dan overbodig

Dus algemeen advies: gebruik with ... end with
CSS: 
Sub M_snb()
    With Blad2
      .Cells.UnMerge
      .Columns.Hidden = False
      .UsedRange.Columns(1).SpecialCells(4).EntireRow.Delete
      .UsedRange.Columns(5).SpecialCells(2).EntireRow.Delete
      For r = 1 To .Range("A1").CurrentRegion.Rows.Count
        If .Cells(r, 1) = "G" Then
            .Cells(r, 4) = "*** DEPARTMENT: " & .Cells(r, 2)
            .Cells(r, 2) = ""
        End If
      Next
      .Columns("K:P").Delete xlToLeft
      .Columns("E:H").Delete xlToLeft
      .Columns("B:B").Cut Columns("G:G")
      .Columns("A:A").Delete xlToLeft
      .Rows("1:1").Insert xlDown
      .Range("A1").Resize(, 9) = split("NavCode Ref Desc Quantity unit PosNo PurPrice SalPrice Supplier")
     ActiveWindow.FreezePanes = False
     .Cells.EntireColumn.AutoFit
   End With
End Sub
 
Je moet ingelogd zijn om te kunnen reageren. Log in | Registreer
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan