ich habe in der Spalte X (24) einen langen Text.
Nun möchte ich in der Spalte Y (25) den Text kopiert haben bis zum Komma.
Immer ab Zeile 4 bis zum Ende, das Ende sool in der Spalte "B" ermittelt werden.
Wenn möglich mit einem Makro ?
mfg walli
sub TextWurm()
erstesKomma=instr(1,range("X24"),",")
Textbisdahin=left(range("X24"),erstesKomma-1)
range("Y25")=Textbisdahin
end sub
Sub Teilmich()
for zae1=4 to 23 ' Die 23 kannst du deiner Zeilenanzahl anpassen
left(cells(zae1,"X"),instr(1,cells(zae1,"X"),",")-1).copy
cells(zae1,"Y").paste
next zae1
end sub
Sub Teilmich()
'Text in Spalte X (24) bis zum 1. Komma ausschneiden und in Spalte Y (25) eintragen
Dim zae1 As Long, sText As String
For zae1 = 4 To 23 ' Die 23 kannst du deiner Zeilenanzahl anpassen
sText = Cells(zae1, 24).Text
'Komma im Text vorhanden
If InStr(1, sText, ",") > 1 Then
Cells(zae1, 25) = Left(sText, InStr(1, sText, ",") - 1)
'Komma an 1. Position
ElseIf InStr(1, sText, ",") = 1 Then
Cells(zae1, 25).ClearContents
Else
'Kein Komma im text
Cells(zae1, 25).ClearContents
' Cells(zae1, 25)=sText
End If
Next zae1
End Sub
Sub TeilKommaXY()
Dim arrA, arrE() As String, zz As Long
arrA = Cells(4, 24).Resize(Cells(Rows.Count, 2).End(xlUp).Row - 3)
ReDim arrE(1 To UBound(arrA))
For zz = 1 To UBound(arrE)
arrE(zz) = Split(arrA(zz, 1), ",")(0)
Next zz
Cells(4, 25).Resize(UBound(arrE)) = Application.Transpose(arrE)
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Sub TeilKommaXYv2()
Dim arrA, zz As Long
arrA = Cells(4, 24).Resize(Cells(Rows.Count, 2).End(xlUp).Row - 3)
For zz = 1 To UBound(arrA)
arrA(zz, 1) = Split(arrA(zz, 1), ",")(0)
Next zz
Cells(4, 25).Resize(UBound(arrA)) = arrA
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Sub TeilKommaXYv3()
Dim arrA, zz As Long, strE As String
arrA = Cells(4, 24).Resize(Cells(Rows.Count, 2).End(xlUp).Row - 3)
For zz = 1 To UBound(arrA)
strE = Split(arrA(zz, 1), ",")(0)
arrA(zz, 1) = strE & IIf(strE arrA(zz, 1), ",", "")
Next zz
Cells(4, 25).Resize(UBound(arrA)) = arrA
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Sub Teilmich2()
Dim arrA, zz As Long, strE As String
arrA = Cells(4, 24).Resize(Cells(Rows.Count, 2).End(xlUp).Row - 3)
For zz = 1 To UBound(arrA)
If Len(arrA(zz, 1)) > 0 Then
strE = Split(arrA(zz, 1), ",")(0)
arrA(zz, 1) = IIf(strE = arrA(zz, 1), "", strE)
End If
Next zz
Cells(4, 25).Resize(UBound(arrA)) = arrA
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort