Zoeken en vervangen tot einde kolom

Status
Niet open voor verdere reacties.
M

mary1995

Gebruiker
Lid geworden
2 mei 2013
Berichten
46
Hallo allemaal,

Ik ben bezig met een code die bankrekeningnummers moet aanpassen in een overzicht.

Het gaat om een bestand dat uiteindelijk in een boekhoudprogramma moet worden geïmporteerd, door een fout bij de bank (waarvan wij niet weten wanneer dit opgelost gaat worden). Worden de rekeningnummers gedownload zonder IBAN. Nu moet door middel van een macro alle rekeningnummers omgezet worden naar iban. Ik heb een lijst met de ibannummers. Wat dus inhoudt dat er alleen gezocht hoeft te worden naar :25: en het achterliggende 9 cijfers omgezet moet worden naar de IBAN.

Dit is het stuk dat geen enkel probleem geeft. De loop om dit proces te herhalen zit er ook in.

Maar het probleem is, alleen het eerste gegeven in de kolom wordt gevonden. En gaat niet door naar de volgende cel die de waarde :25: bevat. Zie tevens ook bijlage met voorbeeldgegevens. De gele kolom is de kolom waar de gegevens moeten worden aangepast naar het gegeven dat wordt weergegeven in kolom A. Ik heb nu de cellen leeggemaakt, maar het is een hele rij gegevens in kolom P waarvan alleen het stukje achter :25: aangepast moet worden.

Hieronder is tevens de macro te zien die ik heb ingevoerd. Ik vermoed zelf dat het in het stukje: set zoeken = Range("P: P").find(":25:") zit. Maar ik weet niet hoe ik deze kan ombouwen dat het wel werkt?

Code: 
Sub zoekenvervangen()
Dim i As Integer
numrows = Range("P1", Range("P1").End(xlDown)).Rows.Count


    Range("P1").Select
    
    For i = 1 To numrows
    Set zoeken = Range("P:P").Find(":25:") 

    If zoeken Is Nothing Then
        answer = MsgBox("niet gevonden", vbOKOnly)
        If answer = vbOK Then Exit Sub
        
    Else
    
        zoeken.Select
        
        Set iban = Range("B:B").Find(activecell, LookIn:=xlValues)
                
            If iban Is Nothing Then
                antwoord = MsgBox("Geen overeenkomsten meer gevonden", vbOKOnly)
                If antwoord = vbOK Then Exit Sub
                
                
            Else
                
                zoeken.Select
                activecell = Replace(activecell, Right(activecell, 9), iban.Offset(0, -1))
                

            End If

        End If

        activecell.Offset(1, 0).Select
    Next

    
End Sub

Ik hoop dat jullie mij kunnen helpen. Alvast bedankt!
 

Bijlagen

  • test.xlsm
    22,1 KB · Weergaven: 17
Bedankt voor de reactie! Ik heb het gedaan wat je zei, alleen met een aanpassing. Ik heb niet de Iban gedaan maar het zoeken. Aangezien het hier gaat om het zoeken naar de volgende cel waar :25: in staat. Het probleem is nu, dat er niet verder wordt gezocht dan de eerste 3 resultaten. En die 3 resultaten worden meerdere keren "aangetikt" als ik de macro uitvoer. Ik heb geen idee in welk deeltje van de code dit kan zitten?

Onderstaand de code zoals die nu is.

Code: 
Sub zoekenvervangen()
Dim i As Integer
numrows = Range("P1", Range("P1").End(xlDown)).Rows.Count


    Range("P1").Select
    Set zoeken = Range("P:P").Find(":25:")
        If zoeken Is Nothing Then
   
    Else
    
        zoeken.Select
        Set iban = Range("B:B").Find(ActiveCell, LookIn:=xlValues)
                
            If iban Is Nothing Then
            
            Else
                
                zoeken.Select
                ActiveCell = Replace(ActiveCell, Right(ActiveCell, 9), iban.Offset(0, -1))
                

            End If

        End If

        ActiveCell.Offset(1, 0).Select
    
    
    For i = 1 To numrows
        Set zoeken = Range("P:P").FindNext(zoeken)
    
    If zoeken Is Nothing Then

    Else
    
        zoeken.Select
        
        Set iban = Range("B:B").Find(ActiveCell, LookIn:=xlValues)
                
            If iban Is Nothing Then
                
            Else
                
                zoeken.Select
                ActiveCell = Replace(ActiveCell, Right(ActiveCell, 9), iban.Offset(0, -1))
                

            End If

        End If

    Next

    
End Sub
 
Dan heb je dus niet gedaan wat ik voorstelde.
Zoals je het nu hebt gaat het niet werken.
Er staat een duidelijk voorbeeld in de link die ik plaatste.
 
Bedankt voor je reactie,
Ik heb nog even gekeken, maar ik snap niet helemaal hoe ik het moet plaatsen?
Het voorbeeld in de link is inderdaad vrij duidelijk, maar toch kom ik er niet helemaal uit.

Ik heb mijn code (naar mijn gevoel) herschreven naar het voorbeeld, maar in de loop zelf ben ik nog niet erg in thuis. En nu gebeurd er dus eigenlijk niets.

Ik heb het idee dat de code die ik zelf heb gemaakt naar aanleiding van het voorbeeld helemaal uit zijn verband is en dus niet meer werkt. Maar ik ben hem even kwijt hoe ik het kan doen zodat het wel werkt.

Hoop dat je het niet erg vindt om mij nog een keer ermee op weg te helpen?

De code die ik nu heb, waarvan ik het idee heb dat die helemaal niet meer klopt:
Code: 
Sub zoekenvervangen1()

    Range("P1").Select
    Set zoeken = Range("P:P").Find(":25:")

    If zoeken Is Nothing Then
        firstaddress = zoeken.Address
        
    Do
        zoeken.Select
        
        Set iban = Range("B:B").Find(ActiveCell, LookIn:=xlValues)
                zoeken.Select
                ActiveCell = Replace(ActiveCell, Right(ActiveCell, 9), iban.Offset(0, -1))
        Set iban = Range("B:B").FindNext(iban)
                
            If iban Is Nothing Then
                GoTo Donefinding
            End If
                
            Loop While zoeken.Address <> firstaddress
            
            End If

Donefinding:
    
End Sub
 
Als je je document plaatst wil ik er vanavond wel even naar kijken.
 
Super, bedankt alvast. Ik heb de gegevens even allemaal anoniem gemaakt. En fictieve bankrekeningnrs gedaan zoals in de openingpost. Alleen nu even met wat meer gegevens en ook de tekst er tussenin ingevuld zoals het normaal is.
 

Bijlagen

  • test.xlsm
    23,4 KB · Weergaven: 26
Waarschijnlijk iets sneller.

Code: 
Sub VenA()
  ar = Sheets("Blad1").ListObjects(1).DataBodyRange
  ar1 = Range("P1:P" & Cells(Rows.Count, 16).End(xlUp).Row)
  For j = 1 To UBound(ar1)
    If Left(ar1(j, 1), 4) = ":25:" Then
      For jj = 1 To UBound(ar)
        If Right(ar1(j, 1), 9) = Right(ar(jj, 1), 9) Then
          ar1(j, 1) = "25:" & ar(jj, 1)
          Exit For
        End If
      Next jj
      If jj = UBound(ar) + 1 Then c00 = c00 & ar1(j, 1) & vbLf
    End If
  Next j
  Cells(1, 18).Resize(UBound(ar1)) = ar1
  If Len(c00) > 0 Then MsgBox "niet gevonden: " & vbLf & c00
End Sub
 
Laatst bewerkt:
VenA, bedankt voor je reactie! Alleen begrijp ik de code niet helemaal. Als ik deze laat uitvoeren, krijg ik op het einde een hele lijst met de codes die niet worden gevonden (dat is zegmaar alle codes, ondanks dat ze wel gewoon in de lijst voorkomen).
 
Er staat een 1 teveel

Code: 
If Right(ar1(j, 1), 9) = Right(ar[COLOR="#FF0000"]1[/COLOR](jj, 1), 9) Then
deze moet weg.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan