- Katılım
- 12 Şubat 2015
- Mesajlar
- 520
- Excel Vers. ve Dili
- Office 2016 TR 64 Bit Windows
- Altın Üyelik Bitiş Tarihi
- 01-02-2027
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub Verileri_Ozel_Karakterlere_Gore_Sutunlara_Bol()
Dim Veri As Variant, Son As Long, X As Long
Dim Metin As String, Kelime As Variant, Y As Integer
Range("B:XFD").Clear
Son = Cells(Rows.Count, 1).End(3).Row
If Son < 2 Then Son = 2
Veri = Range("A1:A" & Son).Value
ReDim Liste(1 To UBound(Veri, 1), 1 To 100)
For X = LBound(Veri, 1) To UBound(Veri, 1)
If Veri(X, 1) <> "" Then
Metin = Veri(X, 1)
Metin = Replace(Replace(Replace(Metin, "#", " "), "%", " "), "&", " ")
Kelime = Split(Metin, " ")
For Y = LBound(Kelime) To UBound(Kelime)
Liste(X, Y + 1) = Kelime(Y)
Next
End If
Next
Range("B1").Resize(UBound(Liste, 1), UBound(Liste, 2)) = Liste
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Sub Test()
NoA = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To NoA
Range("B" & i) = Split(Range("A" & i), "#")(0)
Range("C" & i) = Split(Split(Range("A" & i), "#")(1), "%")(0)
Range("D" & i) = Split(Split(Split(Range("A" & i), "#")(1), "%")(1), "&")(0)
Range("E" & i) = Split(Range("A" & i), "&")(1)
Next
End Sub