Sütunda veri ayıklama

[ascoli]

Merhaba Arkadaşlar;
Excelde bir sütunda sayı ve harflerden oluşan "zip,şehir" verileri bulunmakta eğer mümkünse bu iki veriyi ayıklamak istiyorum.Mesela A sütununda sadece posta kodları kalsın excel b sütununa şehirleri taşısın.
İlgilenen herkese şimdiden teşekkür ederim.

 

[Ömer]

Merhaba,

Küçük bir örnek dosya eklermisiniz.

 

[ascoli]

Merhaba Ömer;
Bulamadım dosya ekleme butonunu zaten çok basit şöyleki sütunda sırayla "34732 istanbul,36500 kars,74800 münih" bu şekilde gidiyo.Yada dosyayı rapidshare atıp linkini ekleyebilirim.Tşekkür ederim ilgine.

 

[Ömer]

Sorunun devamında, ataç eklemek( Dosya eklemek).

B1:

=soldan(a1;bul(" ";a1)-1)

c1:

=sağdan(a1;uzunluk(a1)-uzunluk(b1)-1)

.

 

[ascoli]

Dosyayı ekledim küçük bi veri var normalde 250000 veri ayıklamam gerekiyor.

 

[Ömer]

Merhaba,

Kodları module kopyalarak çalıştırın.

Sub Deneme()
Dim i As Long
On Error Resume Next
    For i = 1 To [A65536].End(3).Row
        Cells(i, "B") = Split(Cells(i, "A"), " ")(0)
        Cells(i, "C") = Split(Cells(i, "A"), " ")(1)
    Next i
End Sub

.

 

[mesudiye_052]

Selamlar;
Alternatif

Sub ayıklama()
For a = 1 To [A65536].End(3).Row
On Error Resume Next
c = WorksheetFunction.Search(" ", Cells(a, 1), 1)
Cells(a, 2) = Mid(Cells(a, 1), 1, c)
Cells(a, 3) = Mid(Cells(a, 1), c, 100)
Next a
MsgBox "İşlem Tamam"
End Sub

 

[ascoli]

Merhaba;
Çalıştı ) Ömer,mesudiye ilginize tekrar teşekkür ederim muazzam bir zaman kazandırdınız bana.

 

[Ömer]

Merhaba,

Aslında bu soruyu Veri / Metni Sütunlara dönüştür menüsünden yapabilirdiniz.

Bu kod diğerine göre çok daha hızlı çalışır.

Sub Deneme()
Application.ScreenUpdating = False
    Columns("B:C").ClearContents
    Columns("A:A").TextToColumns Range("B1"), Space:=True
Application.ScreenUpdating = True
End Sub

.
.

 

[ascoli]

Merhaba Ömer Bey;

Teşekkür ederim kodlar harika çalıştı gördüğüm kadarıyla excel bilginiz muazzam.

Merhaba,

Aslında bu soruyu Veri / Metni Sütunlara dönüştür menüsünden yapabilirdiniz.

Bu kod diğerine göre çok daha hızlı çalışır.

Sub Deneme()
Application.ScreenUpdating = False
    Columns("B:C").ClearContents
    Columns("A:A").TextToColumns Range("B1"), Space:=True
Application.ScreenUpdating = True
End Sub

.
.

 

[ascoli]

Bu kod 0 ile başlayan posta kodlarını 0 olmadan ayıklıyor bunu giderebilir miyiz acaba?

Teşekkürler

Merhaba,

Aslında bu soruyu Veri / Metni Sütunlara dönüştür menüsünden yapabilirdiniz.

Bu kod diğerine göre çok daha hızlı çalışır.

Sub Deneme()
Application.ScreenUpdating = False
    Columns("B:C").ClearContents
    Columns("A:A").TextToColumns Range("B1"), Space:=True
Application.ScreenUpdating = True
End Sub

.
.

 

[Ömer]

Bu kod 0 ile başlayan posta kodlarını 0 olmadan ayıklıyor bunu giderebilir miyiz acaba?

Teşekkürler

Bu şekilde deneyin.

Sub Deneme()
Application.ScreenUpdating = False
    Columns("B:C").ClearContents
    Columns("A:A").TextToColumns Range("B1"), xlDelimited, Space:=True, _
    FieldInfo:=Array(Array(1, 2), Array(2, 1))
Application.ScreenUpdating = True
End Sub

.

 

[ascoli]

Merhaba;

Ömer bey teşekkürler sıfır sorununu çözdüm.
İlginize tekrar teşekkür ederim.

Bu şekilde deneyin.

Sub Deneme()
Application.ScreenUpdating = False
    Columns("B:C").ClearContents
    Columns("A:A").TextToColumns Range("B1"), xlDelimited, Space:=True, _
    FieldInfo:=Array(Array(1, 2), Array(2, 1))
Application.ScreenUpdating = True
End Sub

.

 

[ascoli]

Bri önceki mesajda eklenmemişti.