bir hücredeki verileri ayrı hücrelere ayırmak

[etalayhan]

s.a.
sayın üstadlar, Ek'li dosyada bulunan 2 numaralı excel dosyasında var olan verileri 1 numaralı excell dosyasına çevirmek istiyorum.
Örneğin : a1 hücresinde yazan "excel web tr" kelimesini Ek'te bulunan 1 numaralı excel dosyasının a1,b1,c1 hücreler halinde bölünmesini sağlayan uygulama var mıdır ?
Konuyla ilgili yardımlarınızı bekler, saygılar sunarım.

 

[Ömer BARAN]

ad ve soyadları başka belgede iki sütuna ayırarak aktarmak mı istiyorsunuz?

 

[ZorBey_]

Merhaba
İyi Çalışmalar
İstediğiniz
2. Dosyadaki A Sutunundaki
Ad Ve Soyadınımı
Ayırmak İstiyorsunuz
Örnek Adı A sutununda
soyadı B sutununda Öyle Bir Şeymi Acaba

 

[ZorBey_]

Ad Ve Soyadı Ayrılmış
Dosyanız Ektedir

 

[etalayhan]

hayır üstadım, Ben öğretmenim ve öğrencilerin bilgilerini güncellememiz ve ayırmamız gerekiyor. Bu da MEB e bildirilecek ancak yarın son gün
ek'li dosyada da görüldüğü gibi "O" sütununda bulunan açık adres alanını JKLMN sütunlarına (yerlerine göre) ayırmak istiyorum.
Örneğin J sütununda mahalle yazıyorsa "O" hücresindeki mahalle "J" sütununa sadece mahalle adını yazsın.
"O" hücresinde bulunan adreste cadde adı varsa (cad., cd., vs.) "K" sütununa,
"O" hücresinde bulunan adreste sokak (sk, sk., sokak, sokak. gibi) varsa "L" sütununa aktarsın istiyorum.

Konuyu umarım anlatabilmişimdir. Aciliyetinden dolayı cevabınızı bekliyor, saygılar sunuyorum.

 

[SadiSerdari]

Bildiğim oranda örnek kod göndermeye çalışıyorum. Adreste belirli bir kriter olmadığı ve kimi zaman Mah., Sok., Sk., Cad., Cd., şeklinde değişkenlik arz ettiği için boşlukları esas alacak şekilde ayırıp diğer sayfaya aktarıyor. 2 adlı excel dosyasına makroyu ekleyerek deneyin.

Sub ayirAktar()

    drPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(ThisWorkbook.Path) & "\" & "1.xlsx"

    Set pageName1 = ThisWorkbook.Worksheets("BEV_OGRENCI_LIST")
    Set bookName1 = Workbooks.Open(Filename:=drPath)
    Workbooks("2.xls").Activate
    Set pageName2 = bookName1.Worksheets("Sayfa1")
    
    lastRow = pageName1.Range("A2:A" & Rows.Count).End(xlDown).Row
    For firstRow = 2 To lastRow
        iSeparates = Split(pageName1.Cells(firstRow, 8), " ")
        iValue = 10
        For iArray = 0 To UBound(iSeparates)
            pageName2.Cells(firstRow + 1, iValue) = Left(iSeparates(iArray), Len(iSeparates(iArray)))
            
        iValue = iValue + 1
        Next
    Next
   
    Workbooks("1.xlsx").Activate
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Workbooks("2.xls").Activate
    MsgBox "İşlem Tamamlanmıştır" & vbNewLine & "Lüften Aktarma yapılan Dosyayı Kontrol Edin!", vbInformation

End Sub