DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub DÜZENLE()
Dim X As Long, Y As Integer
Dim KELİME
Dim EN_BÜYÜK As Integer
[B:IV].ClearContents
For X = 2 To [A65536].End(3).Row
KELİME = Split(Cells(X, 1), " ")
For Y = 0 To UBound(KELİME)
If Not IsNumeric(Left(KELİME(Y), 1)) Then
If Cells(X, 256) = "" Then
Cells(X, 256) = KELİME(Y)
Else
Cells(X, 256) = Cells(X, 256) & " " & KELİME(Y)
End If
Cells(X, 254) = Trim(Replace(Cells(X, 1), Cells(X, 256), ""))
Cells(X, 255) = Len(Cells(X, 254))
End If
Next
Next
EN_BÜYÜK = WorksheetFunction.Max([IU:IU])
If EN_BÜYÜK > 0 Then
For X = 2 To [A65536].End(3).Row
Cells(X, 2) = Cells(X, 254) & " " & WorksheetFunction.Rept(" ", (EN_BÜYÜK) - Len(Cells(X, 254))) & Cells(X, 256)
Next
End If
[IT:IV].ClearContents
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Option Explicit
Sub DÜZENLE()
Dim X As Long, Y As Integer
Dim KELİME
Dim EN_BÜYÜK As Integer
[F:IV].ClearContents
For X = 2 To [E65536].End(3).Row
KELİME = Split(Cells(X, 5), " ")
For Y = 0 To UBound(KELİME)
If Not IsNumeric(Left(KELİME(Y), 1)) Then
If Cells(X, 256) = "" Then
Cells(X, 256) = KELİME(Y)
Else
Cells(X, 256) = Cells(X, 256) & " " & KELİME(Y)
End If
Cells(X, 254) = Trim(Replace(Cells(X, 5), Cells(X, 256), ""))
Cells(X, 255) = Len(Cells(X, 254))
End If
Next
Next
EN_BÜYÜK = WorksheetFunction.Max([IU:IU])
If EN_BÜYÜK > 0 Then
For X = 2 To [E65536].End(3).Row
Cells(X, 6) = Cells(X, 254) & " " & WorksheetFunction.Rept(" ", (EN_BÜYÜK) - Len(Cells(X, 254))) & Cells(X, 256)
Next
End If
[IT:IV].ClearContents
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub