Helpmij.nl
Helpmij.nl
Helpmij.nl
Steun Helpmij.nl! Klik hier     Computerprobleem? Klik hier!

Quote

Weergeven resultaten 1 tot 6 van 6

Onderwerp: foutmelding procedure te groot

  1. #1
    Senior Member
    Geregistreerd
    5 september 2016
    Vraag is niet opgelost

    foutmelding procedure te groot

    Hello,

    in bijlage vinden jullie een excelbestand waarin ik alle data, uitgenomen de data waar het over gaat, heb weggehaald. in de code zijn variabelen gedeclareerd die ik nodog heb om andere zaken in het excel bestand te gaan uitvoeren. vanwege de gevoeligheid van de gegevens heb ik enkel de met dit probleem gerelateerde gegevens behouden.

    ik heb een lijst met niscodes die vertaald moeten worden naar de daarbij horende gemeentenaam. in de databank waaruit deze gegevens gehaald worden staan enkel de codes. ik wil deze omzetten naar de gemeentenamen om het voor de gebruiker van het bestand leesbaarder te maken.

    hiervoor gebruik ik een case. was ff wat programmeerwerk maar het werkt wel (voor de andere data (die ik om privacy redenen heb weggehaald) in de tabel werkt het wel trouwens)

    wanneer ik de code laat lopen krijg ik echter een foutmelding dat de procedure te groot is. hoe kan ik dit oplossen? wat is er een eventueel alternatief? kan iemand mij heel ff helpen?

    alvast bedankt


    lijst controles afgeslangte versie helpmij.xlsm

  2. #2
    Tera Honourable Senior Member
    Verenigingslid
    OctaFish's avatar
    Geregistreerd
    6 februari 2009
    Locatie
    Rotterdam
    Afstand tot server
    ±151 km
    Waarom gebruik je niet een tabel met de plaatsnamen en Vert.Zoeken? Lijkt mij een heel stuk handiger.
    Gebruik de QUOTE knop alleen als je iets wit citeren.
    Op deze pagina kun je zien hoe je met TAGS werkt.

  3. #3
    Senior Member
    Geregistreerd
    5 september 2016
    zou inderdaad ook een optie zijn maar hoe steek ik dat verticaal zoeken in vba, rekening houdend met onderstaand gegeven?

    de ene keer staat de info in kolom h, de andere keer in kolom g, dan weer in kolom a, .... ik wilhet zo flexibel mogelijk maken. vandaar ook dat ik eerst met een input box werk en vraag in welke kolom de te vertalen codes staan.....

    PS in de excelfile is reeds een tabblad met de tabel
    Laatst aangepast door rocknroadie : 11 juli 2018 om 13:37

  4. #4
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    Als je de gegevens toch al in een tabel hebt staan dan ga je de toch niet hard in de code zetten?

    Bv
    Code:
    Sub VenA()
    Dim c00, t As Long, j As Long, cl As Range, ar
      c00 = InputBox("In welke kolom staat de situatie (sit) van de kaart?" & vbCrLf & vbCrLf & "OPGELET!!!!" & vbCrLf & "De vertaling van de codes zal gebeuren op de door U aangegeven kolom!" & vbCrLf & "Ongeacht de inhoud van de kolom!")
      If Len(Trim(c00)) <> 1 Or Asc(UCase(c00)) < 65 Or Asc(UCase(c00)) > 90 Or IsNumeric(c00) Then Exit Sub
      t = Asc(UCase(c00)) - 64
      ar = Sheets("Niscodes").Cells(1).CurrentRegion
      On Error Resume Next
      For Each cl In Sheets("gegevens").Columns(t).SpecialCells(2, 1)
        For j = 2 To UBound(ar)
          If cl = ar(j, 1) Then
            cl = ar(j, 2)
            Exit For
          End If
        Next j
      Next cl
    End Sub
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  5. #5
    Giga Honourable Senior Member
    Verenigingslid

    Geregistreerd
    12 juni 2008
    De tabel in 'Niscodes' bevat bijna 700 doublures. Verwijder die eerst.

    Gebruik geen samengevoegde cellen.

    Bespaart al gauw 7 overbodige uitroeptekens:

    Code:
    Sub M_snb()
      Blad1.Cells.UnMerge
      sn = Sheet1.Cells(1).CurrentRegion
      sp = Blad1.Columns(7).SpecialCells(2)
       
      With CreateObject("scripting.dictionary")
        For j = 1 To UBound(sn)
          .Item(sn(j, 1)) = sn(j, 2)
        Next
         
        For j = 1 To UBound(sp)
          sp(j, 1) = .Item(sp(j, 1))
        Next
      End With
        
      Blad1.Columns(7).SpecialCells(2).Offset(, -6).Offset(, Asc(UCase(Left(InputBox("In welke kolom staat de situatie (sit) van de kaart?" & vbCrLf & vbCrLf & "De vertaling van de codes zal gebeuren op de door U aangegeven kolom" & vbCrLf & "ongeacht de inhoud van de kolom", "OPGELET"), 1))) - 65) = sp
    End Sub
    Je kunt er de funktie van een dictionary mooi mee illustreren.

    PS. Ik heb een reptielenfobie
    Laatst aangepast door snb : 13 juli 2018 om 11:45
    VBA voor smarties
    VBA is een taal die je moet leren met een grammatica- en een woordenboek.

    http://www.helpmij.nl/forum/announcement.php?f=5
    Plaats svp geen bestanden op andere sites; nadat het bestand daar verwijderd is wordt een forumdraad onbegrijpelijk voor anderen.

  6. #6
    Senior Member
    Geregistreerd
    5 september 2016
    thx a lot!

    ik heb het opgelost met volgende code:

    Code:
    Sub TranslateNiscode()
    
    Dim lngRowTeller As Long 'lngRowTeller wordt gebruikt om het anatal rijden in op te slaan dat moet gewijzigd worden
    Dim lngNiscode As Long
    Dim lngKolomindicator As Long
    Dim j As Long
    Dim rngGegevens As Range, rngNiscodes
    
    Blad1.Activate
    
    
    strkolomletter = InputBox("In welke kolom staat de situatie (sit) van de kaart?" & vbCrLf & vbCrLf & "OPGELET!!!!" & vbCrLf & "De vertaling van de codes zal gebeuren op de door U aangegeven kolom!" & vbCrLf & "Ongeacht de inhoud van de kolom!")
    
        If Len(Trim(strkolomletter)) <> 1 Or Asc(UCase(strkolomletter)) < 65 Or Asc(UCase(strkolomletter)) > 90 Or IsNumeric(strkolomletter) Then
    
            MsgBox ("Jammer, deze functie kan enkel gebruikt worden als de te vertalen waardes in een kolom staan tussen kolom A en kolom Z (kolom A en Z inbegrepen)")
            Exit Sub
        
        End If
    
        lngKolomindicator = Asc(UCase(strkolomletter)) - 64
        rngNiscodes = Sheets("Niscodes").Cells(1).CurrentRegion
      '  On Error Resume Next
        For Each rngGegevens In Sheets("gegevens").Columns(lngKolomindicator).SpecialCells(2, 1)
         For j = 2 To UBound(rngNiscodes)
          If rngGegevens = rngNiscodes(j, 1) Then
            rngGegevens = rngNiscodes(j, 2)
             Exit For
           End If
         Next j
     Next rngGegevens
    
        Columns(strkolomletter).EntireColumn.AutoFit
        Columns(strkolomletter).HorizontalAlignment = xlCenter
    
    
    End Sub

  7. Dit topic is automatisch gesloten omdat er sinds vier maanden niet meer op gereageerd is.

    Indien gewenst kan de topicstarter een verzoek tot heropening indienen.

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl en business

Partners
Sponsoren