Celsplitsen

[HWV]

Ik heb een bestand van ongeveer 4000 regels, die ik wil splitsen.
De opbouw is het zelfde het aantal regels en de inhoud verscheelt in de cel

Ik heb in cel H2 tekst staan op gebouwd als volgt:
Na de regel heb ik een alt enter gebruikt om een nieuwe regel te vullen

Omschrijving : Buisfolie
Materiaal : LDPE
Kleur : Transparant
Breedte : 100 mm
Rol lengte : 525 meter
Dikte : 100 micron
Gewicht per rol : ± 10 kilo

Nu wil ik deze graag splitsen.
Dit is wat ik graag zo willen in de kolommen ernaast I tm ....

Omschrijving Buisfolie Materiaal LDPE Kleur Transparant Breedte 100 mm Rol lengte 525 meter Dikte 100 micron Gewicht per rol ± 10 kilo

In de bijlage een regel uit het bestand: Bekijk bijlage Helpmij_ celsplitsen.xlsx

Alvast bedankt voor de hulp, als er een oplossing in VBA is dan mag dit ook

HWV

 

[Timshel]

Misschien zo:

Sub tsh()
    Dim Br, Bq
    Dim i As Long
    
    Br = Sheets("Blad1").Range("H1").EntireColumn.SpecialCells(2)
    For i = 1 To UBound(Br)
        Bq = Split(Replace(Br(i, 1), " : ", vbLf), vbLf)
        Cells(i, "I").Resize(, UBound(Bq) + 1) = Bq
    Next
End Sub

 

[HWV]

Mis een stukje

Timshel

Bedankt voor de input, kom ik zeker verder mee.
Enkel hij neem van de laatste regel niet alles mee:

Ik heb een andere regel van het bestand gepakt:

Omschrijving : Siliconen bakplaten papier op rol
Uitvoering : 2-zijdig gesiliconeerd
Materiaal : Siliconen papier
Dikte : 57 grams
Formaat : ± 500 mm
Lengte : ± 50 meter
Kleur : Wit

Eenheid per rol : 10 kilo

Kwaliteitskeurmerk : Voedselveilig

Het rode stuk neemt hij niet mee.

Groet HWV

 

[VenA]

Het voorbeeld en de vraag zal wel niet volledig zijn maar obv van het voorbeeldje

Sub VenA()
[i1].Resize(1, 14) = Split(Replace(Replace([H1], ":", "|"), Chr(10), "|"), "|")
End Sub

Edit blijkbaar 2 berichten gemist:d

 

[Timshel]

@hwv.
De code in #2 is aangepast, waarschijnlijk nét nadat je hem gekopieerd had.

 

[HWV]

Waanzinnig

Beste,

Het is opgelost werkt perfect en mijn vraag is hiermee beantwoord.
Maar zoals meestal kom je de volgende vraag al weer tegen :=)

Zoals ik al aangaf is de cel inhoud telkens anders:

Omschrijving : Buisfolie
Materiaal : LDPE
Kleur : Transparant
Breedte : 100 mm
Rol lengte : 525 meter
Dikte : 100 micron
Gewicht per rol : ± 10 kilo

Omschrijving : Siliconen bakplaten papier op rol
Uitvoering : 2-zijdig gesiliconeerd
Materiaal : Siliconen papier
Dikte : 57 grams
Formaat : ± 500 mm
Lengte : ± 50 meter
Kleur : Wit

Omschrijving : Aluminiumbakken
Materiaal : A-Pet
Temperatuur advies : -40 °C to +70
Product categorie : Gourmet Express™

Aantal per zak : 50 stuks
Aantal per doos : 250 stuks
Aantal per pallet : 18 dozen
Totaal aantal per pallet : 4.500 stuks
Antal m3 per doos : 0,103 m3

Brutogewicht per karton : 6,8 kg
Brutogewicht per pallet : 121,8 kg (e x cl. pallet)

Ik weet niet of het mogelijk is maar om na het draaien van de code en alles gesplitst is de gegevens in de juiste kolommen te zetten
Dat alle omschrijvingen onder elkaar staan en dit voor alle andere namen voor de : ook en daarachter natuurlijk de waarde`s


Ik hoop dat dit mogelijk is, en anders een hoop hand werk maar ben hier al aardig mee geholpen

HWV
Kwaliteitskeurmerk : Voedselveilig

 

[VenA]

Had ik het in #4 aardig goed. Plaats een voorbeeldbestand met wat meer regels en hoe het moet worden.

 

[HSV]

Sub hsv()
Dim cl As Range, sq
For Each cl In Columns(8).SpecialCells(2)
  sq = Split(Replace(cl, ":", vbLf), vbLf)
  cl.Offset(, 1).Resize(, UBound(sq) + 1) = sq
Next cl
End Sub

 

[HWV]

Bekijk bijlage Helpmij_ celsplitsen.xlsm

Beste,

Zie voorbeeld bestand en in tabblad 2 hoe ik het voor ogen heb,

Groet HWV

 

[Timshel]

Bijgaand een oplossing die iets anders is dan je vraagt, maar volgens mij wel een overzichtelijker resultaat geeft.
Uitvoer op Blad 2.

 

[HWV]

Top

Dit scheelt mij zoveel veel werk, top dank hiervoor.
Er zitten lege regels tussen waar hij op vast loop, die moeten nog gevuld worden dus niet zo erg dat hij daar op vast loop.

Ik heb een On Error Resume Next er tussen gezet om dit te ondervangen

Groet HWV

 

[HSV]

Mooie code @Timshel.

Een andere manier:
Hierbij wordt niet in het blad gezocht met de 'Find' methode, maar weer in de items van de .keys.

Sub tsh_hsv()
    Dim Br, Bq, Bv
    Dim i As Long, j As Long, x As Long, k As Long
    
    Br = Sheets("Blad3").Columns(8).SpecialCells(2)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(Br)
            Bq = Split(Br(i, 1), vbLf)
            For j = 0 To UBound(Bq)
                If Trim(Bq(j)) <> "" Then .Item(Split(Bq(j), " : ")(0)) = Split(Bq(j), " : ")(0)
            
            Next
        Next
        Sheets("Sheet1").Cells(1, 1).Resize(, .Count) = .keys
        ReDim Bv(0 To UBound(Br), 0 To .Count)
  
    For i = 1 To UBound(Br)
        Bq = Split(Br(i, 1), vbLf)
        For j = 0 To UBound(Bq)
         For x = 0 To .Count
            If Trim(Bq(j)) <> "" Then
             If Split(Bq(j), " : ")(0) = .Item(.keys()(x)) Then
               Bv(i - 1, x) = Split(Bq(j), " : ")(1)
               Exit For
             End If
            End If
        Next x
       Next j
    Next i
    Sheets("Sheet1").Cells(2, 1).Resize(UBound(Bv), UBound(Bv, 2)) = Bv
    End With
End Sub

 

[Timshel]

@hsv. Is waarschijnlijk iets sneller

 

[HWV]

Code Timshel is sneller

Timshel ,

Mijn ervaring is op het gehele bestand is dat jou code drie keer sneller is, als dat die van HSV.
In ieder geval allemaal bedankt voor jullie inspanning, ik ben hier mee geholpen

HWV

 

[snb]

Ik zou er liever een echte tabel van maken:

Sub M_snb()
    sn = Blad1.Columns(8).SpecialCells(2)
    sp = Filter(Split(Replace(Replace(Join(Application.Transpose(Blad1.Columns(8).SpecialCells(2)), ":"), " :", "~:"), vbLf, ":"), ":"), "~")
    For j = 0 To UBound(sp)
       If InStr(c00, sp(j)) = 0 Then c00 = c00 & sp(j)
    Next
    sp = Split(c00, "~")
    ReDim sq(UBound(sn) + 1, UBound(sp))
    
    For j = 1 To UBound(sn)
        st = Split(Join(Filter(Split(sn(j, 1), vbLf), " :"), " :"), " :")
        For jj = 0 To UBound(st) Step 2
          sq(j - 1, Application.Match(st(jj), sp, 0) - 1) = st(jj + 1)
        Next
    Next
    
    Blad2.Cells(10, 1).Resize(, UBound(sp) + 1) = sp
    Blad2.Cells(11, 1).Resize(UBound(sq) + 1, UBound(sq, 2)) = sq
End Sub

 

[HWV]

Andere insteek

SNB,

De code van u getest maar schiet in fouten.
- Variabele is niet gedefineerd

- en een fout in de volgende regel

          sq(j - 1, Application.Match(st(jj), sp, 0) - 1) = st(jj + 1)

HWV

 

[HWV]

Eeen aanvullende vraag /probleem waar ik tegen aan loop

Beste,

Ik was blij dat het gelukt was en had gedacht dat dit de oplossing zou zijn geweest voor mijn probleem.
Niks is anders waar, daar ik het bestand moet aanleveren in HTML:

<P style="BORDER-TOP-COLOR: ; BORDER-BOTTOM-COLOR: ; BORDER-RIGHT-COLOR: ; BORDER-LEFT-COLOR: ">Omschrijving : Cateringschalen<BR>Materiaal : Aluminium <BR>Volume : 805 ml<BR>Vakindeling : 805 ml <BR>Kleur : Zilver<BR>Vorm : Rechthoekig<BR><BR>Aantal per zak : 10 stuks<BR>Aantal per doos : 100 stuks<BR><BR>Voedselgeschikt : goedgekeurd<BR><BR>Formaat top out : 350 x 243 mm <BR>Formaat top in : 327 x 225 mm <BR>bodem : 257 x 156 mm <BR>Hoogte : 21 mm </P>

Het het staat dus zo in een cel:

Omschrijving : Cateringschalen
Materiaal : Aluminium
Volume : 805 cc
Vakindeling : 1-vaks
Kleur : Zilver
Vorm : Rechthoekig

Aantal per zak : 10 stuks
Aantal per doos : 100 stuks

Kwaliteitskeurmerk : Voedselveilig

Formaat top out : 350 x 243 mm
Formaat top in : 327 x 225 mm
bodem : 257 x 156 mm
Hoogte : 21 mm

Nu is het de bedoeling dat ik de cel inhoud omzet naar HTML code zoals hierboven aangegeven.
Ik heb zitten denken aan samenvoegen nadat ik het script heb gedraaid en dat alles in kolommen staat.

Maar doordat niet elk cel de zelfde inhoud heeft zou ik hier geen oplossing voor weten.

Is dit gelijk te doen met een script of moet ik anders denken.

Alvast bedankt voor de hulp

HWV

 

[HWV]

Oplossing gevonden, maar omslachtig

Beste,

Ik ben er uit maar zal niet de schoonheid wedstrijd winnen, maar wist niet hoe het anders zou moeten.

In de bijlage het bestand, een klein gedeelte nadat bovenstaande is gebeurd op het gehele orginele bestand.
Zodat we de kolom hoofden compleet hebben

Bekijk bijlage Helpmij_ celsplitsen.xlsm

Ik heb deze formule gebruikt , doordat niet elke cel de zelfde waarde heeft, en als de waarde in de kolom niet gevuld is hoef hij deze ook niet mee te nemen in de waarde:

=TEKST.SAMENVOEGEN($DF$1;ALS(A2="";"";$A$1);ALS(A2="";"";$DI$1);ALS(A2="";"";A2);ALS(A2="";"";$DG$1);ALS(B2="";"";$B$1);ALS(B2="";"";$DI$1);ALS(B2="";"";B2);ALS(B2="";"";$DG$1);ALS(C2="";"";$C$1);ALS(C2="";"";$DI$1);ALS(C2="";"";C2);ALS(C2="";"";$DG$1);ALS(D2="";"";$D$1);ALS(D2="";"";$DI$1);ALS(D2="";"";D2);ALS(D2="";"";$DG$1);ALS(E2="";"";$E$1);ALS(E2="";"";$DI$1);ALS(E2="";"";E2);ALS(E2="";"";$DG$1);ALS(F2="";"";$F$1);ALS(F2="";"";$DI$1);ALS(F2="";"";F2);ALS(F2="";"";$DG$1);ALS(G2="";"";$G$1);ALS(G2="";"";$DI$1);ALS(G2="";"";G2);ALS(G2="";"";$DG$1);ALS(H2="";"";$H$1);ALS(H2="";"";$DI$1);ALS(H2="";"";H2);ALS(H2="";"";$DG$1);ALS(I2="";"";$I$1);ALS(I2="";"";$DI$1);ALS(I2="";"";I2);ALS(I2="";"";$DG$1);ALS(J2="";"";$J$1);ALS(J2="";"";$DI$1);ALS(J2="";"";J2);ALS(J2="";"";$DG$1);ALS(K2="";"";$K$1);ALS(K2="";"";$DI$1);ALS(K2="";"";K2);ALS(K2="";"";$DG$1);ALS(L2="";"";$L$1);ALS(L2="";"";$DI$1);ALS(L2="";"";L2);ALS(L2="";"";$DG$1);ALS(M2="";"";$M$1);ALS(M2="";"";$DI$1);ALS(M2="";"";M2);ALS(M2="";"";$DG$1);ALS(N2="";"";$N$1);ALS(N2="";"";$DI$1);ALS(N2="";"";N2);ALS(N2="";"";$DG$1);ALS(O2="";"";$O$1);ALS(O2="";"";$DI$1);ALS(O2="";"";O2);ALS(O2="";"";$DG$1);ALS(P2="";"";$P$1);ALS(P2="";"";$DI$1);ALS(P2="";"";P2);ALS(P2="";"";$DG$1);ALS(Q2="";"";$Q$1);ALS(Q2="";"";$DI$1);ALS(Q2="";"";Q2);ALS(Q2="";"";$DG$1);ALS(R2="";"";$R$1);ALS(R2="";"";$DI$1);ALS(R2="";"";R2);ALS(R2="";"";$DG$1);ALS(S2="";"";$S$1);ALS(S2="";"";$DI$1);ALS(S2="";"";S2);ALS(S2="";"";$DG$1);ALS(T2="";"";$T$1);ALS(T2="";"";$DI$1);ALS(T2="";"";T2);ALS(T2="";"";$DG$1);ALS(U2="";"";$U$1);ALS(U2="";"";$DI$1);ALS(U2="";"";U2);ALS(U2="";"";$DG$1);ALS(V2="";"";$V$1);ALS(V2="";"";$DI$1);ALS(V2="";"";V2);ALS(V2="";"";$DG$1);ALS(W2="";"";$W$1);ALS(W2="";"";$DI$1);ALS(W2="";"";W2);ALS(W2="";"";$DG$1);ALS(X2="";"";$X$1);ALS(X2="";"";$DI$1);ALS(X2="";"";X2);ALS(X2="";"";$DG$1);ALS(Y2="";"";$Y$1);ALS(Y2="";"";$DI$1);ALS(Y2="";"";Y2);ALS(Y2="";"";$DG$1);ALS(Z2="";"";$Z$1);ALS(Z2="";"";$DI$1);ALS(Z2="";"";Z2);ALS(Z2="";"";$DG$1);ALS(AA2="";"";$AA$1);ALS(AA2="";"";$DI$1);ALS(AA2="";"";AA2);ALS(AA2="";"";$DG$1);ALS(AB2="";"";$AB$1);ALS(AB2="";"";$DI$1);ALS(AB2="";"";AB2);ALS(AB2="";"";$DG$1);ALS(AC2="";"";$AC$1);ALS(AC2="";"";$DI$1);ALS(AC2="";"";AC2);ALS(AC2="";"";$DG$1);ALS(AD2="";"";$AD$1);ALS(AD2="";"";$DI$1);ALS(AD2="";"";AD2);ALS(AD2="";"";$DG$1);ALS(AE2="";"";$AE$1);ALS(AE2="";"";$DI$1);ALS(AE2="";"";AE2);ALS(AE2="";"";$DG$1);ALS(AF2="";"";$AF$1);ALS(AF2="";"";$DI$1);ALS(AF2="";"";AF2);ALS(AF2="";"";$DG$1);ALS(AG2="";"";$AG$1);ALS(AG2="";"";$DI$1);ALS(AG2="";"";AG2);ALS(AG2="";"";$DG$1);ALS(AH2="";"";$AH$1);ALS(AH2="";"";$DI$1);ALS(AH2="";"";AH2);ALS(AH2="";"";$DG$1);ALS(AI2="";"";$AI$1);ALS(AI2="";"";$DI$1);ALS(AI2="";"";AI2);ALS(AI2="";"";$DG$1);ALS(AJ2="";"";$AJ$1);ALS(AJ2="";"";$DI$1);ALS(AJ2="";"";AJ2);ALS(AJ2="";"";$DG$1);ALS(AK2="";"";$AK$1);ALS(AK2="";"";$DI$1);ALS(AK2="";"";AK2);ALS(AK2="";"";$DG$1);ALS(AL2="";"";$AL$1);ALS(AL2="";"";$DI$1);ALS(AL2="";"";AL2);ALS(AL2="";"";$DG$1);ALS(AM2="";"";$AM$1);ALS(AM2="";"";$DI$1);ALS(AM2="";"";AM2);ALS(AM2="";"";$DG$1);ALS(AN2="";"";$AN$1);ALS(AN2="";"";$DI$1);ALS(AN2="";"";AN2);ALS(AN2="";"";$DG$1);ALS(AO2="";"";$AO$1);ALS(AO2="";"";$DI$1);ALS(AO2="";"";AO2);ALS(AO2="";"";$DG$1);ALS(AP2="";"";$AP$1);ALS(AP2="";"";$DI$1);ALS(AP2="";"";AP2);ALS(AP2="";"";$DG$1);ALS(AQ2="";"";$AQ$1);ALS(AQ2="";"";$DI$1);ALS(AQ2="";"";AQ2);ALS(AQ2="";"";$DG$1);ALS(AR2="";"";$AR$1);ALS(AR2="";"";$DI$1);ALS(AR2="";"";AR2);ALS(AR2="";"";$DG$1);ALS(AS2="";"";$AS$1);ALS(AS2="";"";$DI$1);ALS(AS2="";"";AS2);ALS(AS2="";"";$DG$1);ALS(AT2="";"";$AT$1);ALS(AT2="";"";$DI$1);ALS(AT2="";"";AT2);ALS(AT2="";"";$DG$1);ALS(AU2="";"";$AU$1);ALS(AU2="";"";$DI$1);ALS(AU2="";"";AU2);ALS(AU2="";"";$DG$1);ALS(AV2="";"";$AV$1);ALS(AV2="";"";$DI$1);ALS(AV2="";"";AV2);ALS(AV2="";"";$DG$1);ALS(AW2="";"";$AW$1);ALS(AW2="";"";$DI$1);ALS(AW2="";"";AW2);ALS(AW2="";"";$DG$1);ALS(AX2="";"";$AX$1);ALS(AX2="";"";$DI$1);ALS(AX2="";"";AX2);ALS(AX2="";"";$DG$1);ALS(AY2="";"";$AY$1);ALS(AY2="";"";$DI$1);ALS(AY2="";"";AY2);ALS(AY2="";"";$DG$1);ALS(AZ2="";"";$AZ$1);ALS(AZ2="";"";$DI$1);ALS(AZ2="";"";AZ2);ALS(AZ2="";"";$DG$1);ALS(BA2="";"";$BA$1);ALS(BA2="";"";$DI$1);ALS(BA2="";"";BA2);ALS(BA2="";"";$DG$1);ALS(BB2="";"";$BB$1);ALS(BB2="";"";$DI$1);ALS(BB2="";"";BB2);ALS(BB2="";"";$DG$1);ALS(BC2="";"";$BC$1);ALS(BC2="";"";$DI$1);ALS(BC2="";"";BC2);ALS(BC2="";"";$DG$1);ALS(BD2="";"";$BD$1);ALS(BD2="";"";$DI$1);ALS(BD2="";"";BD2);ALS(BD2="";"";$DG$1);ALS(BE2="";"";$BE$1);ALS(BE2="";"";$DI$1);ALS(BE2="";"";BE2);ALS(BE2="";"";$DG$1);ALS(BF2="";"";$BF$1);ALS(BF2="";"";$DI$1);ALS(BF2="";"";BF2);ALS(BF2="";"";$DG$1);ALS(BG2="";"";$BG$1);ALS(BG2="";"";$DI$1);ALS(BG2="";"";BG2);ALS(BG2="";"";$DG$1);ALS(BH2="";"";$BH$1);ALS(BH2="";"";$DI$1);ALS(BH2="";"";BH2);ALS(BH2="";"";$DG$1);ALS(BI2="";"";$BI$1);ALS(BI2="";"";$DI$1);ALS(BI2="";"";BI2);ALS(BI2="";"";$DG$1);ALS(BJ2="";"";$BJ$1);ALS(BJ2="";"";$DI$1);ALS(BJ2="";"";BJ2);ALS(BJ2="";"";$DG$1);ALS(BK2="";"";$BK$1);ALS(BK2="";"";$DI$1);ALS(BK2="";"";BK2);ALS(BK2="";"";$DG$1);;$DH$1)

Ik heb kolom DF1, DG1 en DH1 als vaste waarde in de formule gezet, ik om anders in de knel met het aantal tekens in een formule

Zijn hier opmerkingen of aanvullingen op ik hoor het graag

Ik hoop dat mijn vraag hiermee een stuk duidelijker is geworden

HWV