Code verkorten

[rvt1982]

Ik heb de volgende code die goed werkt, maar volgens mij kan deze korter..

wie zou mij hier mee kunnen helpen ?

alvast bedankt.



' D1Onderzoek1 = tekst

sn = Split(D1Onderzoek1)
aantal_woorden = Len(D1Onderzoek1) - Len(Replace(D1Onderzoek1, " ", ""))

'-----------------------------------------
'Regel 1


If aantal_woorden > 16 Then
    aantal_woorden16 = 16
Else
    aantal_woorden16 = aantal_woorden
End If


For j = 0 To aantal_woorden16
   splitsJ = splitsJ & sn(j) & " "
Next j
 


    x = x + 1
    .Range("C" & x) = splitsJ


'-----------------------------------------
'Regel 2

If aantal_woorden > 16 Then


If aantal_woorden > 30 Then
    aantal_woorden30 = 30
Else
    aantal_woorden30 = aantal_woorden
End If


    For K = 17 To aantal_woorden30
    splitsK = splitsK & sn(K) & " "
    Next K

    x = x + 1
    .Range("C" & x) = "      " & splitsK


End If

'-----------------------------------------
'Regel 3

If aantal_woorden > 30 Then

If aantal_woorden > 50 Then
    aantal_woorden51 = 50
Else
    aantal_woorden50 = aantal_woorden
End If

    For L = 31 To aantal_woorden50
    splitsL = splitsL & sn(L) & " "
    Next L

    x = x + 1
    .Range("C" & x) = "      " & splitsL

End If


'-----------------------------------------

 

[edmoor]

Je code is incompleet en vreemd opgebouwd qua inspringpunten. Zo gaat iemand niet snel moeite doen om te kijken of het korter kan.

 

[rvt1982]

incompleet valt wel mee, dit betreft alleen de tekst, en de regel nummer, maar je hebt gelijk, moet wel compleet zijn.
ik heb de code aangevuld.

Function Tekst()

D1Onderzoek1 = "Dit moet een hele lange tekst voorstellen met veel woorden, ik kon zo even geen tekst vinden, dus doe ik het maar even zo."
x = 1

sn = Split(D1Onderzoek1)
aantal_woorden = Len(D1Onderzoek1) - Len(Replace(D1Onderzoek1, " ", ""))

'-----------------------------------------
'Regel 1


If aantal_woorden > 16 Then
    aantal_woorden16 = 16
Else
    aantal_woorden16 = aantal_woorden
End If


For j = 0 To aantal_woorden16
   splitsJ = splitsJ & sn(j) & " "
Next j
 


    x = x + 1
    .Range("C" & x) = splitsJ


'-----------------------------------------
'Regel 2

If aantal_woorden > 16 Then


If aantal_woorden > 30 Then
    aantal_woorden30 = 30
Else
    aantal_woorden30 = aantal_woorden
End If


    For K = 17 To aantal_woorden30
    splitsK = splitsK & sn(K) & " "
    Next K

    x = x + 1
    .Range("C" & x) = "      " & splitsK


End If

'-----------------------------------------
'Regel 3

If aantal_woorden > 30 Then

If aantal_woorden > 50 Then
    aantal_woorden51 = 50
Else
    aantal_woorden50 = aantal_woorden
End If

    For L = 31 To aantal_woorden50
    splitsL = splitsL & sn(L) & " "
    Next L

    x = x + 1
    .Range("C" & x) = "      " & splitsL

End If


'-----------------------------------------

End Function

 

[snb]

sub M_snb()
  aantal_woorden=ubound(split(Dlonderzoek1))+1
End Sub

 

[mcs51mc]

Kort genoeg ?

Sub Test()
D1Onderzoek1 = "Dit moet een hele lange tekst voorstellen met veel woorden, ik kon zo even geen tekst vinden, dus doe ik het maar even zo. Om toch maar boven de 30 woorden te komen heb ik er maar een vervolg aan gebreid die er hopelijk voor zal zorgen dat we nu wel 3 rijen zullen zien in de Excel sheet vanaf rij x."

sn = Split(D1Onderzoek1)

    For i = 0 To UBound(sn)
        If i < 17 Then
            R1 = R1 & sn(i) & " "
            
        ElseIf i < 30 Then
            R2 = R2 & sn(i) & " "
            
        Else
            R3 = R3 & sn(i) & " "
        End If
    Next i
    
    x = 5
    With ActiveSheet
        .Range("C" & x) = R1: x = x + 1
        .Range("C" & x) = "      " & R2: x = x + 1
        .Range("C" & x) = "      " & R3
    End With
End Sub

 

[Warme bakkertje]

Public Sub Sample()
    Const SampleText = "Dit moet een hele lange tekst voorstellen met veel woorden, ik kon zo even geen tekst vinden, dus doe ik het maar even zo. Om toch maar boven de 30 woorden te komen heb ik er maar een vervolg aan gebreid die er hopelijk voor zal zorgen dat we nu wel 3 rijen zullen zien in de Excel sheet vanaf rij x."
    Dim strLines() As String, i As Long
    
    strLines = Split(SampleText, " ")
    For i = 15 To UBound(strLines) Step 16
        strLines(i) = strLines(i) & " "
    Next
    strLines = Split(Join(strLines, " "), "  ")
    For i = 0 To UBound(strLines)
        Cells(i + 2, 3) = strLines(i)
    Next
    Erase strLines
End Sub

 

[Elsendoorn2134]

rvt1982,

Denk om je opbouw, als je een zelfde taak meerder keren voor laat komen, maak daar dan een functie van.
Dat maakt het zoeken van fouten en andere problemen makkelijker.

Sub Tekst()

Dim sn As Variant
Dim nStart As Integer, nEind As Integer

Const sLangeTekst = "Dit moet een hele lange tekst voorstellen met veel woorden, ik kon zo even geen tekst vinden, dus doe ik het maar even zo. Om toch maar boven de 30 woorden te komen heb ik er maar een vervolg aan gebreid die er hopelijk voor zal zorgen dat we nu wel 3 rijen zullen zien in de Excel sheet vanaf rij x."
sn = Split(sLangeTekst)

Range("C1").Offset(0, 0) = MaakTekst(sn, 0, 15)
Range("C1").Offset(1, 0) = MaakTekst(sn, 16, 29)
Range("C1").Offset(2, 0) = MaakTekst(sn, 30, 49)
Erase sn

End Sub

Private Function MaakTekst(sn As Variant, nStart As Integer, nEind As Integer) As String

Dim sAntwoord As String
Dim nTeller As Integer

If UBound(sn) > nStart Then
    nEind = IIf(UBound(sn) < nEind, UBound(sn), nEind)
    For nTeller = nStart To nEind
        sAntwoord = sAntwoord + sn(nTeller) & " "
    Next
End If
MaakTekst = sAntwoord

End Function

Veel Succes

 

[HSV]

Offset(0,0) = gelijk aan niets.

Public Sub Sample()
    Const SampleText = "Dit moet een hele lange tekst voorstellen met veel woorden, ik kon zo even geen tekst vinden, dus doe ik het maar even zo. Om toch maar boven de 30 woorden te komen heb ik er maar een vervolg aan gebreid die er hopelijk voor zal zorgen dat we nu wel 3 rijen zullen zien in de Excel sheet vanaf rij x."
    Dim strLines() As String, i As Long, strline
    
        strLines = Split(SampleText, " ")
    For i = 15 To UBound(strLines) Step 16
          strLines(i) = strLines(i) & " "
      Next  
    strline = Split(Join(strLines, " "), "  ")
       Cells(2, 3).Resize(UBound(strline) + 1) = Application.Transpose(strline)    
 Erase strLines
End Sub

 

[Warme bakkertje]

Dit

Range("C1").Offset(0, 0) = MaakTekst(sn, 0, 15)
Range("C1").Offset(1, 0) = MaakTekst(sn, 16, 29)
Range("C1").Offset(2, 0) = MaakTekst(sn, 30, 49)

kan je ook vervangen door

Range("C1").Resize(3) = Application.Transpose(Array(MaakTekst(sn, 0, 15), MaakTekst(sn, 16, 29), MaakTekst(sn, 30, 49)))