Cellen splitsen/verplaatsen

Status
Niet open voor verdere reacties.

Tweety1

Gebruiker
Lid geworden
6 mrt 2013
Berichten
637
Ik ben opzoek naar een macro die het volgende doet
In kolom "N" staat tekst die gesplit dient te worden op op basis van "/"
Is de cel in kolom "D" in de volgende regel leeg dan de tekst daar plaatsen
Is de cel in kolom "D" in de volgende regel niet leeg dan regel toevoegen en de tekst daar plaatsen.

mvg

Kasper
 

Bijlagen

  • Cellen splitsen verplaatsen.xlsx
    11,4 KB · Weergaven: 32
Laatst bewerkt:
Dat kan natuurlijk nooit met een ‘query’, maar zal je met een macro moeten oplossen.
 
1. Is de cel in kolom "D" in de volgende regel leeg dan de tekst daar plaatsen
2. Is de cel in kolom "D" in de volgende regel niet leeg dan regel toevoegen en de tekst daar plaatsen.
Ik heb je voorbeeldje even bekeken, maar de door jou geplaatste uitkomst (rij 23 en verder) klopt niet met je vraagstelling. Nemen we de tekst in N5 als voorbeeld: "Tekst14/Tekst14a". Die moet gesplitst worden. Volgens regel 1 zou de tekst (je geeft overigens niet aan of het om het linker deel gaat, of om het rechter deel, maar je uitkomst laat het rechter deel zien) in D5 geplaatst moeten worden als die cel leeg is. Dat is die niet: in D5 staat nu "Tekst4". Dan moeten we dus naar regel 2 kijken: lege regel toevoegen en dan de tekst in D6 plaatsen. Maar dat doe je dus niet. Ik kan wel zien wat je wél doet, maar dat klopt dus niet met je vraagstelling.
 
Je hebt gelijk. Niet erg duidelijk :confused:


Het gaat om het rechter gedeelte van de tekst in kolom "N".

1. Is de cel van de volgende regel in kolom "D" leeg dan moet de tekst in de cel van kolom "N" geplaatst te worden
1. Is de cel van de volgende regel in kolom "D" niet leeg dan moet er een lege regel toevoegt worden en moet er in de cel in kolom "N" de tekst geplaatst worden.
 
Misschien even een voorbeeldbestand plaatsen? Als overal hetzelfde staat en de verwachte uitkomt blijkbaar niet correct is dan is de kans zeer klein dat er iemand iets voor gaat verzinnen. Zelf al wat ondernomen om tot een oplossing te komen?
 
Bij het eerste bericht staat de juiste voorbeeld bestand zoals het eruit moet zien.



Ik heb geprobeerd onderstaande macro aan te passen.

Code:
Sub hsv()
Dim sn, sq, sq1, i As Long, j As Long, jj As Long, n As Long, langste As Long
sn = Sheets("voorbeeld 1").Cells(1).CurrentRegion
ReDim arr(14, 0)
For i = 1 To UBound(sn)
  sq = Split(sn(i, 8), "/")
    sq1 = Split(sn(i, 9), "/")
 langste = IIf(UBound(sq) > UBound(sq1), UBound(sq), UBound(sq1))
      For j = 0 To IIf(langste > -1, langste, 0)
            For jj = 1 To UBound(sn, 2)
             Select Case jj
              Case jj = 1 To 7, 10 To UBound(sn, 2)
                  arr(jj - 1, n) = sn(i, jj)
              Case jj = 8 To 9
                  If j <= UBound(sq) Then arr(7, n) = sq(j)
                  If j <= UBound(sq1) Then arr(8, n) = sq1(j)
               End Select
             Next jj
        n = n + 1
      ReDim Preserve arr(14, n)
    Next j
  Next i
    With Sheets("uitkomst voorbeeld 1")
     .Cells(1).CurrentRegion.Offset(1).ClearContents
     .Cells(1).Resize(UBound(arr, 2), UBound(sn, 2)) = Application.Transpose(arr)
    End With
End Sub
 
Laatst bewerkt:
Test het maar eens, de reacties blijven verder uit merk ik.
 

Bijlagen

  • Cellen splitsen verplaatsen.xlsb
    17,3 KB · Weergaven: 34
Als ik vanavond nog tijd of zin heb zal ik eens kijken of het wat simpeler kan.
Er staat maar een scheidingsteken, misschien kan de tweede tekst meegenomen worden in de normale loop.

En anders laat ik het hier bij deze puzzel.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan