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

Tekst in cel opschonen en splitsen

Status
Niet open voor verdere reacties.
L

LmrBtn

Gebruiker
Lid geworden
1 nov 2017
Berichten
11
Beste forumlezers en specialisten,

Ik heb een vraag over het opschonen van tekst in een cel en het splitsen van de betreffende entiteiten.
Hiervoor heb ik twee verschillende (tekst)cellen met inhoud. Beide cellen moeten uiteindelijk (cel 1) de naam bevatten en (cel 2) de overige gegevens.

Voorbeeld 1:
========

(achternaam LIKE "%BAKKER%") AND (plaats = "MEPPEL")

In dit voorbeeld wil ik graag alleen de naam BAKKER in cel 1 overhouden (of in een nieuwe cel plaatsen) en
MEPPEL in een tweede cel. Ook de leestekens en het procentteken moeten verdwijnen, dus puur de betreffende tekst moet overblijven.

Voorbeeld 2:
========

(achternaam = "BAKKER") AND (adres_toevoeging = "C") AND (gemeente = "GIETEN") AND (huisnummer = 12) AND (plaats = "ROLDE") AND (straat = "STATIONSSTRAAT")

In dit voorbeeld (er zit dus een verschil in de inhoud van de originele cellen) wil ik graag alleen de naam BAKKER in cel 1 overhouden (of in een nieuwe cel plaatsen) en de overige gegevens in een tweede cel plaatsen.
Ook de leestekens moeten verdwijnen, dus puur de betreffende tekst moet overblijven.

Wie kan mij hiermee helpen?
 
Draai deze code eens in een testbestand.
Code: 
Sub hsv()
Dim sv, hs, i As Long, j As Long, y As Long
sv = Cells(1).CurrentRegion.Resize(, 10)
  For i = 1 To UBound(sv)
    hs = Split(sv(i, 1), ")")
      For j = 0 To UBound(hs) - 1
        y = IIf(y < j, y = j, y + 1)
        sv(i, j + 1) = Trim(Replace(Split(hs(j), "=")(1), """", ""))
      Next j
      Next i
 Cells(1, 10).Resize(UBound(sv), y) = sv
End Sub
 
Deels geprobeerd

HSV, bedankt voor je code.

Aangezien ik dit aanzie voor VBA-code, heb ik de VBA module geactiveerd en daarna gestart.
Ik heb in het werkblad een module genaamd HSV aangemaakt.

Maar helaas houdt daarna mijn kennis en mijn probeersels op. Ik kom er niet uit hoe ik de code kan draaien.
Kun je me nog iets verder helpen?
 
Die staan niet in je voorbeeldbestand.
 
Code: 
Sub CleanUpp()
    Range("A1") = Replace(Range("A1"), Chr(34), "")
    Range("A1") = Replace(Range("A1"), Chr(37), "")
End Sub
 
HSV zei:
Draai deze code eens in een testbestand.
Code: 
Sub hsv()
Dim sv, hs, i As Long, j As Long, y As Long
sv = Cells(1).CurrentRegion.Resize(, 10)
  For i = 1 To UBound(sv)
    hs = Split(sv(i, 1), ")")
      For j = 0 To UBound(hs) - 1
        y = IIf(y < j, y = j, y + 1)
        sv(i, j + 1) = Trim(Replace(Split(hs(j), "=")(1), """", ""))
      Next j
      Next i
 Cells(1, 10).Resize(UBound(sv), y) = sv
End Sub
Klik om te vergroten...

Harry [HSV].....De code werkt (op voorbeeld twee)!
Bedankt!
 
Jack Nouws zei:
Code: 
Sub CleanUpp()
    Range("A1") = Replace(Range("A1"), Chr(34), "")
    Range("A1") = Replace(Range("A1"), Chr(37), "")
End Sub
Klik om te vergroten...

Jack, bedankt voor het meedenken. De code werkt gedeeltelijk op voorbeeld 1.
Ik krijg na het draaien van de code de volgende rest tekst:

(achternaam LIKE BAKKER) AND (plaats = MEPPEL)

Dus je CHR(34) en CHR(37) functie begrijp ik en die beide karakters worden verwijderd.
Nu nog iets uitbouwen tot BAKKER en MEPPEL overblijven en in twee aparte cellen worden gezet?
 
Als die 12 (huisnummer) in voorbeeld 2 ook tussen dubbele quotes staat, is dit een code voor 1 en 2.
'Resize(,10)' geeft het aantal te verwachten kolommen aan, die is in dit voorbeeld aan de grote kant, maar maakt niet uit.

Code: 
Sub hsv()
Dim sv, hs, i As Long, j As Long, y As Long
sv = Cells(1).CurrentRegion.Resize(, 10)
  For i = 1 To UBound(sv)
    hs = Split(sv(i, 1), ")")
      For j = 0 To UBound(hs) - 1
        y = IIf(y < j, j, y + 1)
        sv(i, j + 1) = Trim(Replace(Replace(Split(hs(j), """")(1), """", ""), "%", ""))
      Next j
      Next i
 Cells(1, 10).Resize(UBound(sv), y) = sv
End Sub
 
Laatst bewerkt:
Loopt vast op huisnummer

Inderdaad Harry, dan werken ze op beiden. Gek genoeg staat 12 niet tussen dubbele quotes, maar daar kom ik wel uit.
Hartelijk bedankt voor de code !
 
Zo kan het voor beide.
Code: 
Sub hsv()
Dim sv, hs, i As Long, j As Long, y As Long
sv = Cells(1).CurrentRegion.Resize(, 10)
  For i = 1 To UBound(sv)
    hs = Split(sv(i, 1), ")")
      For j = 0 To UBound(hs) - 1
        y = IIf(y < j, j, y + 1)
        On Error Resume Next
        sv(i, j + 1) = Trim(Replace(Replace(Split(hs(j), """")(1), """", ""), "%", ""))
        If Err.Number <> 0 Then sv(i, j + 1) = Trim(Replace(Split(hs(j), "=")(1), """", ""))
      Next j
      Next i
 Cells(1, 10).Resize(UBound(sv), y) = sv
End Sub
 
HSV zei:
Zo kan het voor beide.
Code: 
Sub hsv()
Dim sv, hs, i As Long, j As Long, y As Long
sv = Cells(1).CurrentRegion.Resize(, 10)
  For i = 1 To UBound(sv)
    hs = Split(sv(i, 1), ")")
      For j = 0 To UBound(hs) - 1
        y = IIf(y < j, j, y + 1)
        On Error Resume Next
        sv(i, j + 1) = Trim(Replace(Replace(Split(hs(j), """")(1), """", ""), "%", ""))
        If Err.Number <> 0 Then sv(i, j + 1) = Trim(Replace(Split(hs(j), "=")(1), """", ""))
      Next j
      Next i
 Cells(1, 10).Resize(UBound(sv), y) = sv
End Sub
Klik om te vergroten...

Ja, zo werkt het helemaal!
Ik zie alleen dat ik met de eerste twee testregels (rijen) in een werkblad de tekst prima kan omzetten, maar dat als er een blanco rij tussen zit en daarna weer verder gaat, dat de macro dan stopt. Is dat ergens in de code opgesloten?


Gr.
Ron
 
Svp niet citeren/quoten !

Code: 
Sub M_snb()
   Columns(1).Sort Cells(1), 1
   Columns(1).Replace "%",""
   sn = Columns(1).SpecialCells(2).Resize(, 2)
   
   For j = 1 To UBound(sn)
      st = Filter(Split(sn(j, 1) & " ", Chr(34)), " ", 0)
      sn(j, 1) = st(0)
      st(0) = ""
      sn(j, 2) = Trim(Join(st))
   Next
   
   Columns(1).SpecialCells(2).Resize(, 2) = sn
End Sub
 
Niet sorteren

Bedankt SNB!

Zo kan ik er ook wel wat mee, maar ik zie dat de kolommen en rijen netjes gesorteerd worden.
Dat is op zich heel netjes, maar moet echter niet. Is het verwijderen van de lijn "Columns(1).Sort Cells(1), 1" voldoende om dit te voorkomen?
 
Enige opmerking @snb,

Er mist nog het huisnummer.
 
Als het sorteren ongewenst is dan je de inhoud van het blad ook even in een variabele zetten en nadien weer terug zetten.

Bv
Code: 
ar = UsedRange
  code
UsedRange = ar
 
Anders:
Code: 
Sub hsv()
Dim sv, hs, i As Long, j As Long, y As Long
sv = ActiveSheet.UsedRange.Resize(, 10)
  For i = 1 To UBound(sv)
   If sv(i, 1) > 0 Then
    hs = Split(sv(i, 1), ")")
      For j = 0 To UBound(hs) - 1
        y = IIf(y < j, j, y + 1)
        On Error Resume Next
        sv(i, j + 1) = Trim(Replace(Replace(Split(hs(j), """")(1), """", ""), "%", ""))
        If Err.Number <> 0 Then sv(i, j + 1) = Trim(Replace(Split(hs(j), "=")(1), """", ""))
      Next j
   End If
  Next i
 Cells(1, 10).Resize(UBound(sv), y) = sv
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan