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

foutmelding procedure te groot

Status
Niet open voor verdere reacties.
R

rocknroadie

Gebruiker
Lid geworden
5 sep 2016
Berichten
184
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


Bekijk bijlage lijst controles afgeslangte versie helpmij.xlsm
 
Waarom gebruik je niet een tabel met de plaatsnamen en Vert.Zoeken? Lijkt mij een heel stuk handiger.
 
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 bewerkt:
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
 
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 bewerkt:
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
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan