Yan Yana Olan Metin Biçimindeki Verileri Alt Alta Sıralama

[isteobenim]

Merhabalar,

Konu ile ilgili sorum ek döküman içerisindedir.
Yardımlarınız için şimdiden teşekkürler,

İyi Çalışmalar,

 

[Muhammet Okumuş]

Hepsi 10 basamaklı mı sayıların?

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz? Sonuç size göre uygun mudur?

Aşağıdaki kodları bir modüle ekleyip deneyiniz.

Sub Duzenle()
 
    Dim i   As Long, _
        j   As Long, _
        m   As String, _
        s, _
        sh1 As Worksheet, _
        sh2 As Worksheet
 
    Set sh1 = Sheets("Sayfa1")
    Set sh2 = Sheets("Sayfa2")
 
    Application.ScreenUpdating = False
 
    For i = 2 To sh1.Cells(Rows.Count, "A").End(3).Row
 
        m = Application.WorksheetFunction.Trim(Replace(Replace(sh1.Cells(i, "A"), ";", " "), "-", " "))
        s = Split(m, " ")
        j = sh2.Cells(Rows.Count, "A").End(3).Row + 1
        sh2.Cells(j, "A").Resize(UBound(s)+1, 1) = Application.WorksheetFunction.Transpose(s)
 
    Next i
 
    Application.ScreenUpdating = True
 
    MsgBox "DÜZENLEME BİTMİŞTİR...", vbInformation, "excel.web.tr - N. Yeşertener"
 
End Sub

 

[Muhammet Okumuş]

Necdet Bey tamamında aynı sayıları verdi. Sanırım kodda hata var.

 

[isteobenim]

Necdet Bey,

Kodlar aşağıdaki satırda hata vererek tüm satırlarda sadece ilk boşluğa kadar olan aynı değerleri yazmaktadır. 1.satırda yazılacak 6 kalem değer olmasına rağmen sonuç 20 satır olarak çıkmıştır.

sh2.Cells(j, "A").Resize(UBound(s), 1) = s

(Karekter sayısı sabittir.Sürekli 10 karakter olacaktır. MBUL,UZUNLUK,PARÇAAL fonksiyonlarıyla yapmaya çalıştım ama maalesef başarılı olamadım)


İyi Çalışmalar,

 

[isteobenim]

Günaydın,

Soru günceldir,

İyi Çalışmalar,

 

[Necdet]

Merhaba,

Önceki mesajımda küçük bir değişiklik yaptım. Onu atlamışım.

sh2.Cells(j, "A").Resize(UBound(s)+1, 1) = Application.WorksheetFunction.Transpose(s)

cümlesinde Transpose u unutmuşum.

 

[isteobenim]

Merhaba, Necdet Bey,

Cevabınız için teşekkür ederim.
Bu hali ile işimi görmektedir ancak, revize ettiğiniz satırda "run time error 13 type mismatch" hatası vererek çalışmakta ,veri tipi metin olduğundan olsa gerek , düzeltilebilir mi? Birde aynı veriler aynı sütunda 4 defa tekrarlanmaktadır.

İyi Çalışmalar,

 

[Necdet]

Merhaba, Necdet Bey,

Cevabınız için teşekkür ederim.
Bu hali ile işimi görmektedir ancak, revize ettiğiniz satırda "run time error 13 type mismatch" hatası vererek çalışmakta ,veri tipi metin olduğundan olsa gerek , düzeltilebilir mi? Birde aynı veriler aynı sütunda 4 defa tekrarlanmaktadır.

İyi Çalışmalar,

Merhaba,

Verilerinizin A sütununda ve aynı yapıda olduğu varsayılmıştır.

Örnek dosyanızda verilerinizin altına hem açıklama hemde olması gerektiğini yazmışsınız. Açıklamaları ve olması gerekenleri başka bir sütuna taşıyıp denerseniz hata kodu almazsınız.

Ayrıca sayılar içinde mükerrer veriler varsa onun kontrolü yapılmamıştır.

İmzanızdan Ofis 2007 kullandığınız anlaşılmaktadır. 2007 ve sonraki sürümlerde Veri sekmesinde yinelenenleri kaldır diye yeni bir olanak var. onu kullanabilirsiniz.

 

[isteobenim]

Necdet Bey,

Tekrar teşekkürler, belittiğiniz gibi hata örnekten kaynaklanıyormuş.Şuan tek sıkıntı rakamların başında olan sıfır değerlerinin aktarılamamasıdır.Fonksiyonlar yardımıyla alternatif çözümler bulabilirim ancak kodlar içerisinde yapılacak bir değişklikle mümkün olabilir ise daha güzel olacaktır.

İyi Çalışmalar,

 

[Necdet]

Merhaba,

Kodlarla çözüm olası tabi.

Sayfa2 nin A sütununu ya metin olarak ya da Özel Rakam Biçiminden 10 adet Sıfırlı olarak olarak formatlamak işinizi görür.

Bu ikisini de makro kaydet ile yapmanız olası. Ama siz yorulmaın ben iki kodu da vereyim.

Application.ScreenUpdating = False satırından sonra :

    sh2.Columns("A:A").NumberFormat = "@"

Yukarıdaki kod sayfa2 nin a sütununu metin olarak formatlar.
Aşağıdaki ise rakam olarak.

    sh2.Columns("L:L").NumberFormat = "00000000000"

tercih sizin.

Yukarıdaki kodlardan birini ilgili kod içine yerleştiriniz.

 

[Ömer]

Merhaba,

Fonksiyonlu çözüm. Alternatif olsun.

Sayfa2 A2 hücresine yazıp alt satırlara kopyalayın.

=PARÇAAL(KIRP(YERİNEKOY(YERİNEKOY(KAYDIR(Sayfa1!$A$2
 ;YUKARIYUVARLA(SATIRSAY(A$2:A2)/6;0)-1;0);"-";" ");";";" "))
  ;MOD(SATIRSAY(A$2:A2)-1;6)*11+1;10)

Her satırda 10 lu 6 grup olduğu düşünülmüştür. Veri aralarındaki simgelerin;

Boşluk
-
;

Simgesi(leri) olduğu düşünülmüştür.

.

 

[isteobenim]

Merhaba,

Kodlarla çözüm olası tabi.

Sayfa2 nin A sütununu ya metin olarak ya da Özel Rakam Biçiminden 10 adet Sıfırlı olarak olarak formatlamak işinizi görür.

Bu ikisini de makro kaydet ile yapmanız olası. Ama siz yorulmaın ben iki kodu da vereyim.

Application.ScreenUpdating = False satırından sonra :

    sh2.Columns("A:A").NumberFormat = "@"

Yukarıdaki kod sayfa2 nin a sütununu metin olarak formatlar.
Aşağıdaki ise rakam olarak.

    sh2.Columns("L:L").NumberFormat = "00000000000"

tercih sizin.

Yukarıdaki kodlardan birini ilgili kod içine yerleştiriniz.

Necdet Bey,

Cevap ve sabrınız için çok teşşekkür ederim.

İyi Çalışmalar,

 

[isteobenim]

Merhaba,

Fonksiyonlu çözüm. Alternatif olsun.

Sayfa2 A2 hücresine yazıp alt satırlara kopyalayın.

=PARÇAAL(KIRP(YERİNEKOY(YERİNEKOY(KAYDIR(Sayfa1!$A$2
 ;YUKARIYUVARLA(SATIRSAY(A$2:A2)/6;0)-1;0);"-";" ");";";" "))
  ;MOD(SATIRSAY(A$2:A2)-1;6)*11+1;10)

Her satırda 10 lu 6 grup olduğu düşünülmüştür. Veri aralarındaki simgelerin;

Boşluk
-
;

Simgesi(leri) olduğu düşünülmüştür.

.

Ömer Bey,

İlginiz için teşekkür ederim.
Her kümede 10 karakter sabit, ancak 6 lı grup düşünceniz değişken olabilecektir.Ben /6 ve ;6 değerlerini değiştirdiğimde 2.satırdan sonra rakamlarda kayma ve boşluklar oluşmaktadır.Eğer çözümü var ise ki mutlaka vardırpaylaşabilirseniz sevinirim.

İyi Çalışmalar,

 

[isteobenim]

Ömer Bey,

Örneği farklı hücrelerde denemiştim, sabitlenmiş hücre adreslerinden dolayı doğru sonucu alamıyormuşum,çözümü buldum, ilginiz için tekrar teşekkürler,

İyi Çalışmalar,