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

Bestaande tekst in cel met terugloop vervangen door harde return

  • Onderwerp starter Onderwerp starter radar
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.

radar

Gebruiker
Lid geworden
13 jan 2006
Berichten
242
Excellenties,


Ik heb een excelbestand met daarin een kolom met veel tekst per cel, welke met terugloop er redactioneel en visueel netjes uitziet.
Ik weet dat excel hier in principe niet voor bedoeld is, maar de situatie is nou eenmaal zo.
Deze info moet ik inlezen in een andere applicatie, die niet werkt met terugloop en de tekst in volle breedte plaatst.
Als de tekst wordt aangeboden met harde returns in de cel (alt enter), worden de regels in een cel wel goed overgenomen, met afkapping zoals
in Excel.
An sich logisch, maar nu het probleem.
Het gaat om een grote hoeveelheid regels, zodat een handmatige inhaal/herstelactie geen optie is.
Ik ben daarom op zoek naar een oplossing, waarin dit met formules of vba gebeurt.

In bijlage heb ik voorbeeldbestandje geplaatst.
In voorbeeld nogmaals probleem geformuleerd in de gebruikte zinnen.
Broninfo is met terugloop. gewenst resultaat met harde returns

Is dit mogelijk ??
Wie kan me helpen ??:o

Radar
 

Bijlagen

Hallo Cobbe,

Dank je wel voor je snelle reactie.
Helaas, deze optie had ik al bekeken.
De woorden worden op deze manier afgebroken en de zinsdelen zijn verdeeld over meerdere cellen.
Het is echt de bedoeling om ze in een cel te houden echter met harde returns, alt enter.
Had dit geprobeerd en met functie deel met nagenoeg zelfde resultaat.
Maar misschien is het als tussenstap wel handig.
Kun jij of iemand anders van de door tekst naar kolommen opdeling deze weer samenvoegen in een cel met harde returns tussen de zinsdelen m.b.v. VBA?

Radar
 
Zie volgende post !!!
 
Laatst bewerkt:
Ik dacht aan:

Code:
Sub M_snb()
   sn = Columns(3).SpecialCells(2)
   
   For j = 2 To UBound(sn)
     If Len(Trim(sn(j, 1))) > 30 Then
       st = Split(Trim(sn(j, 1)))
       c00 = ""
       
       For jj = 0 To UBound(st) - 1
         y = Trim(Len(c00)) \ 30
         c00 = c00 & IIf((Len(c00) + Len(" " & st(jj))) \ 30 > y, vbLf, " ") & st(jj)
       Next
       
       sn(j, 1) = Trim(c00) & IIf((Len(c00) + Len(" " & st(jj))) \ 30 > y, vbLf, " ") & st(jj)
     End If
   Next
   
   Cells(1).Resize(UBound(sn)) = sn
End Sub
 
Laatst bewerkt:
Awel, da's toch gin West-Vloams ?
 
Ik ben een polyglot in Vlaanderen, daarmee!
 
Laatst bewerkt:
Excellenties uit Vlaanderen,

Ben niet zo thuis in vba;
Weet ook even niet welk bestand als uitgangspunt is genomen voor code, of ik vooraf een bepaalde rang moet selecteren, alvorens code uit te voeren.
Diverse varianten uitgeprobeerd, doch krijg zowel in mijn oorspronkelijk bestand als in het bestand van Cobbe foutmeldingen of een niet gewenst resultaat.

Is het mogelijk, dat een van U het relevante bestand voorziet van de code en plaatst?
Mijn dank is groot !

Radar
 
Voor de code van snb dient de lijst in kolom C te staan en Kolom A moet leeg zijn.
Dan loopt die code perfect.
 
Inderdaad Cobbe,

wow, dit is al een enorme stap in de goede richting.:thumb:
In bijgevoegd bestand heb ik enkele schoonheidsfoutjes, waar regels worden afgekapt ruim voordat ze dertig posities in beslag nemen rood gemaakt.
Is daar nog fine tuning mogelijk ?

Radar
 

Bijlagen

Code:
Sub M_snb()
   sn = Columns(3).SpecialCells(2)
   
   For j = 2 To UBound(sn)
     If Len(Trim(sn(j, 1))) > 30 Then
       st = Split(Trim(sn(j, 1)))
       c00 = ""
       
       For jj = 0 To UBound(st)
         y = Trim(Len(c00)) \ 30
         c00 = c00 & IIf((Len(c00) + Len(" " & st(jj))) \ 30 > y, vbLf, " ") & st(jj)
       Next
       
       sn(j, 1) = c00
     End If
   Next
   
   Cells(1).Resize(UBound(sn)) = sn
End Sub
 
Laatst bewerkt:
Geweldig snb.
code lijkt precies te doen, wat ik graag wilde zien.
Dank je wel !!
Ga morgen aan de slag met echte bronbestand!
snb, Cobbe bedankt voor inbreng en aangedragen oplossingen.
Als ik morgen een en ander getest heb met echte bronbestand, meld ik me nogmaals en wijzig dan status naar opgelost

Radar
 
snb,
voordat ik morgen aan de slag ga. nog een verzoek.
wat me net opviel was dat in het resultaat de eerste regel steeds begint met een spatie. Is die ook eruit te halen, voordat er posities geteld worden...

Radar
 
Code:
Sub M_snb()
   sn = Columns(3).SpecialCells(2)
   
   For j = 2 To UBound(sn)
     If Len(Trim(sn(j, 1))) > 30 Then
       st = Split(Trim(sn(j, 1)))
       c00 = ""
       
       For jj = 0 To UBound(st)
         y = Trim(Len(c00)) \ 30
         c00 = Trim(c00 & IIf((Len(c00) + Len(" " & st(jj))) \ 30 > y, vbLf, " ") & st(jj))
       Next
       
       sn(j, 1) = c00
     End If
   Next
   
   Cells(1).Resize(UBound(sn)) = sn
End Sub
 
Laatst bewerkt:
Wederom dank voor je snelle reactie.
Soms ligt oplossing dichterbij dan je verwacht...:o

Radar
 
Verbeterde versie:
Code:
Sub M_snb()
   sn = Columns(3).SpecialCells(2)
   
   For j = 2 To UBound(sn)
     If Len(Trim(sn(j, 1))) > 30 Then
       st = Split(Trim(sn(j, 1)))
       c00 = ""
       
       For jj = 0 To UBound(st)
         c00 = c00 & IIf((Len(Replace(c00, vbLf, "")) + Len(st(jj)) + 1) \ 31 > Len(Replace(c00, vbLf, "")) \ 31, vbLf, IIf(c00 = "", "", " ")) & st(jj)
       Next
       
       sn(j, 1) = c00
     End If
   Next
   
   Cells(1).Resize(UBound(sn)) = sn
End Sub
 
Hoi snb,

Leuk te zien, dat vraagstuk je toch bezig houdt en je perfectie nastreeft...

Ik heb de verbeterde versie toegepast, maar zie ook hier een aantal regels die de 30 posities overschrijden.
Zou je nog eens willen kijken; heb zelf al wat gespeeld met de waarde 30 en 31, doch zonder succes.
In bijlage oorspronkelijke bestand met daarop jouw script toegepast. Enkele te lange regels aangegeven.

Groet,
Radar
 

Bijlagen

Had je eenvoudig zelf kunnen vinden....

Code:
Sub M_snb()
   sn = Columns(3).SpecialCells(2)
   
   For j = 2 To UBound(sn)
     If Len(Trim(sn(j, 1))) > 30 Then
       st = Split(Trim(sn(j, 1)))
       c00 = vbLf
       
       For jj = 0 To UBound(st)
         c00 = c00 & IIf(Len(Split(c00, vbLf)(UBound(Split(c00, vbLf))) & st(jj)) + 1 > 30, vbLf, IIf(c00 = vbLf, "", " ")) & st(jj)
       Next
       
       sn(j, 1) = Mid(c00, 2)
     End If
   Next
   
   Cells(1).Resize(UBound(sn)) = sn
End Sub
 
Ha ha snb ....
Ik heb de scriptjes naast elkaar gelegd en zie inderdaad de verschillen..., maar dat ik het nou snap...
Vba.. de V staat zeker voor Vlaams ;)

Maar het werkt nu perfect !
Dank je wel voor de inspanning !:thumb:

Groet,
Radar
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan