• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Hücreleri tekrar düzenleme

Katılım
20 Temmuz 2010
Mesajlar
8
Excel Vers. ve Dili
2007
Merhaba arkadaşlar,

Yeni üye oldum, öncelikle merhabalar.
Daha önce excel ile hiç bir işim olmadığı için bilgisizim. Ama zamanla sanırım bişeyler öğreneceğim. 1-2 ihtiyacım var, bana yardımcı olabilirseniz çok sevinirim.

Yukarıdan aşağıya;
Yetkili adı,
firma ismi,
adres,
vs vs,
vs vs,
telefon,
fax,
web sitesi,
email adresi

şeklinde kayıtlar var.

Yapmak istediğim biraz karmaşık, yeniden düzenlemem gerekli.

Bu verileri Outlook a contact bilgisi olarak girmeliyim. Bu sebeple CSV gibi bir formata dönüştürmeliyim.

Ama öncesinde bunları düzenlemeli ve ayırmalıyım. Anlayabildiğim kadarı ile macrolar ile bu işlem yapılabiliyor.

1 firma için için olan bilgi bazen 8 bazen 7 bazen de 9 satır. Aralarda 3-5-8 satır boşluklar var. Ama firma bilgisinde en altta hep email adresi var.
Macro ile boş satırları silebiliyorum. Ancak en sonunda yatay olarak sıralamam gerekeceği için boş satırları tamamen silmek işimi çözmüyor.

Yapılması gereken şey şu.
Alt alta email adresinden sonraki boş satırlar silinmeli.
Satırlarda "Phone:" , "Tel:" yada "Fax:" gibi kelimeler çıkartılmalı (varsa).
Sonrada herbiri birer satır olacak şekilde yatay olarak hizalanmalı.

Sizler için basit olabilir ancak, benim düzeyimde excel kullanıcısı için bu ölüm. Bu konuda yardımcı olmanız mümkün mü ?
Ya da ben ne yapmalıyım ? Nasıl yapabilirim ?

Şimdiden teşekkür ederim.
 
kullanılabilecek komutlar
Thisworkbook.worksheets(1).cells(satir,sutun).value komutu ile bilgi okutulur ve bir string değişkene atanır.
instr komutu ile bir text içinde başka bir text aratılabilir ve bulunursa kaçıncı karakterde bulunduğu bilgisi veriri
örn:
instr(1,"Merhaba","a",1) komutunun sonucu "a" harfinin geçtiği ilk konum olan 5 olacaktır. bundan sonra len komutu ile stringin boyu öğrenilir. daha sonra right veya left veya her iki komutun kombinasyonları ile string içinden istenilen bilgiler seçilebilir.
 
kullanılabilecek komutlar
Thisworkbook.worksheets(1).cells(satir,sutun).value komutu ile bilgi okutulur ve bir string değişkene atanır.
instr komutu ile bir text içinde başka bir text aratılabilir ve bulunursa kaçıncı karakterde bulunduğu bilgisi veriri
örn:
instr(1,"Merhaba","a",1) komutunun sonucu "a" harfinin geçtiği ilk konum olan 5 olacaktır. bundan sonra len komutu ile stringin boyu öğrenilir. daha sonra right veya left veya her iki komutun kombinasyonları ile string içinden istenilen bilgiler seçilebilir.

Saollasın Usta, bunun üzerinde çalışacağım.


Selamlar,

Forumumuza hoşgeldiniz.

Aşağıdaki link sizin için faydalı olabilir.

http://www.excel.web.tr/showthread.php?t=83168

Teşekkürler, ancak benim sorunum o değil.. Oraya gelene kadar öncelikli olarak verileri düzenlemeliyim.


Yukarıdan aşağıya satırlar başka bir sayfaya yatay olarak aktarılmalı. Sanırım bunu "transpose" yapıyormuş.
Fakat aşağıya doğru giderken içinde "@" olan satır dahil. Yeni kayıt başlangıcı ise sonrasında dolu olan ilk satır.

Ama yeni sayfaya aktarılacak olan satır sayısı değişebildiği için sabit bir satır adedi kullanamayız. Aklıma gelen en iyi çözüm "@" işaretini algılatmak. Ki bu yeni satıtırın son sütunu olacak.

Biraz karışık görünüyor ama aslında basit.
Ama ben yapmasını bilmiyorum :S

Kodu yazmama yardımcı olabilirmisiniz ?
 
Selamlar,

Örnek dosya üzerinde düzenlenmesi gereken verilerinizden bir kaç örnek ekleyin. Ayrıca verilerinizin olması gereken halinide ekleyinki yardımcı olmak isteyen arkadaşlarımıza kolaylık olsun.
 
aşağıdaki kod satir değerini okur, değer içinde "@" işareti görene kadar alt alta değerleri birbirlerine ekler. ancak bunu tek bir adres bilgisi için yapıyor. diğerleri için bir döngü daha kurmak gerekir ancak bunun için her bir address satırının ne ile bitip ne ile başladığını, aralarında boş satır olup olmadığını bilmek gerekiyor. aralarda boş satır var ise iş biraz daha zor.

Sub deneme()
satir = 3 'başlangıç satırı
Do While InStr(1, ThisWorkbook.Worksheets(1).Cells(satir, 1).Value, "@", vbTextCompare) = 0
Address = Address & ThisWorkbook.Worksheets(1).Cells(satir, 1).Value & " "
satir = satir + 1
Loop
Address = Address & " " & ThisWorkbook.Worksheets(1).Cells(satir, 1).Value
MsgBox Address
End Sub
 
Selamlar,

Aşağıdaki kodu denermisiniz. Kodun sağlıklı çalışması için verilerinizin içinde geçen aşağıdaki ibareler kullanılmıştır. Eğer bu ibarelerin olmadığı verileriniz varsa kod doğru sonuç üretmeyecektir.

Kullanılan ibareler;
LTD
CADDE
,
@


Kod:
Option Explicit
 
Sub VERİLERİ_DÜZENLE()
    Dim S1 As Worksheet
    Dim S2 As Worksheet
    Dim X As Long, Y As Long
    Dim Ara_Satır As Long, Satır As Long
 
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
 
    S2.Cells.Clear
    Satır = 1
 
    For X = 1 To S1.Range("A65536").End(3).Row
        If S1.Cells(X, 1) <> "" Then
            Ara_Satır = S1.Cells(X, 1).End(4).Row
            If Ara_Satır = 65536 Then GoTo Devam
 
            For Y = X To Ara_Satır
                If InStr(1, S1.Cells(Y, 1), "LTD", vbTextCompare) > 0 Then
                    S2.Cells(Satır, 1) = S1.Cells(Y, 1)
                ElseIf InStr(1, S1.Cells(Y, 1), "CADDE", vbTextCompare) > 0 Then
                    S2.Cells(Satır, 2) = S1.Cells(Y, 1)
                ElseIf InStr(1, S1.Cells(Y, 1), ",") > 0 Then
                    If Val(Split(S1.Cells(Y, 1), ",")(1)) > 0 Then
                        S2.Cells(Satır, 3) = S1.Cells(Y, 1)
                    Else
                        S2.Cells(Satır, 4) = S1.Cells(Y, 1)
                    End If
                ElseIf InStr(1, S1.Cells(Y, 1), "TEL:", vbTextCompare) > 0 Then
                    S2.Cells(Satır, 5) = S1.Cells(Y, 1)
                ElseIf InStr(1, S1.Cells(Y, 1), "FAX:", vbTextCompare) > 0 Then
                    S2.Cells(Satır, 6) = S1.Cells(Y, 1)
                ElseIf InStr(1, S1.Cells(Y, 1), "@") > 0 Then
                    S2.Cells(Satır, 7) = S1.Cells(Y, 1)
                End If
 
            Next
Devam:
        Satır = S2.Range("A65536").End(3).Row + 1
        X = Ara_Satır
        End If
    Next
 
    S2.Select
 
    Set S1 = Nothing
    Set S2 = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 

Ekli dosyalar

aşağıdaki kod satir değerini okur, değer içinde "@" işareti görene kadar alt alta değerleri birbirlerine ekler. ancak bunu tek bir adres bilgisi için yapıyor. diğerleri için bir döngü daha kurmak gerekir ancak bunun için her bir address satırının ne ile bitip ne ile başladığını, aralarında boş satır olup olmadığını bilmek gerekiyor. aralarda boş satır var ise iş biraz daha zor.

Sub deneme()
satir = 3 'başlangıç satırı
Do While InStr(1, ThisWorkbook.Worksheets(1).Cells(satir, 1).Value, "@", vbTextCompare) = 0
Address = Address & ThisWorkbook.Worksheets(1).Cells(satir, 1).Value & " "
satir = satir + 1
Loop
Address = Address & " " & ThisWorkbook.Worksheets(1).Cells(satir, 1).Value
MsgBox Address
End Sub

Boşlukları temizleyebiliyorum,
ve aynı zamanda içerisinde email adresi yani (@) olmayanları artıkmanuel temizlemek gerekicek ama olsun.

Sonrasında istediğimi yapacak gibi görünüyor.
Peki dongüyü nasıl sağlıyoruz ?
 
Selamlar,

Aşağıdaki kodu denermisiniz. Kodun sağlıklı çalışması için verilerinizin içinde geçen aşağıdaki ibareler kullanılmıştır. Eğer bu ibarelerin olmadığı verileriniz varsa kod doğru sonuç üretmeyecektir.

Kullanılan ibareler;
LTD
CADDE
,
@


Kod:
Option Explicit
 
Sub VERİLERİ_DÜZENLE()
    Dim S1 As Worksheet
    Dim S2 As Worksheet
    Dim X As Long, Y As Long
    Dim Ara_Satır As Long, Satır As Long
 
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
 
    S2.Cells.Clear
    Satır = 1
 
    For X = 1 To S1.Range("A65536").End(3).Row
        If S1.Cells(X, 1) <> "" Then
            Ara_Satır = S1.Cells(X, 1).End(4).Row
            If Ara_Satır = 65536 Then GoTo Devam
 
            For Y = X To Ara_Satır
                If InStr(1, S1.Cells(Y, 1), "LTD", vbTextCompare) > 0 Then
                    S2.Cells(Satır, 1) = S1.Cells(Y, 1)
                ElseIf InStr(1, S1.Cells(Y, 1), "CADDE", vbTextCompare) > 0 Then
                    S2.Cells(Satır, 2) = S1.Cells(Y, 1)
                ElseIf InStr(1, S1.Cells(Y, 1), ",") > 0 Then
                    If Val(Split(S1.Cells(Y, 1), ",")(1)) > 0 Then
                        S2.Cells(Satır, 3) = S1.Cells(Y, 1)
                    Else
                        S2.Cells(Satır, 4) = S1.Cells(Y, 1)
                    End If
                ElseIf InStr(1, S1.Cells(Y, 1), "TEL:", vbTextCompare) > 0 Then
                    S2.Cells(Satır, 5) = S1.Cells(Y, 1)
                ElseIf InStr(1, S1.Cells(Y, 1), "FAX:", vbTextCompare) > 0 Then
                    S2.Cells(Satır, 6) = S1.Cells(Y, 1)
                ElseIf InStr(1, S1.Cells(Y, 1), "@") > 0 Then
                    S2.Cells(Satır, 7) = S1.Cells(Y, 1)
                End If
 
            Next
Devam:
        Satır = S2.Range("A65536").End(3).Row + 1
        X = Ara_Satır
        End If
    Next
 
    S2.Select
 
    Set S1 = Nothing
    Set S2 = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Ustad , çok teşekkür ederim. Ornek dosyada kod mukemmel çalışıyor.
Ama bendeki dosyalarda çalışmadı.

Bence sebebi veri içerisindeki farklılıklar.

Rica etsem bana Ltd,Cadde, Tel ve Fax ile ne yaptığını söylersen ben bendeki verilerin olduğu dosyaya göre onları değiştireyim.
 
Selamlar,

Sadece bahsettiğim ibareleri kelime içinde arayarak uygun sütunlara yazdırdım. Yapılan işlem bundan ibarettir.
 
Selamlar,

Sadece bahsettiğim ibareleri kelime içinde arayarak uygun sütunlara yazdırdım. Yapılan işlem bundan ibarettir.

Anladım, Sanırım sorunda o yüzden kaynaklandı.

Bazı satırlarda Firma ismi olarak Ltd geçmiyor.
Bazılarında da firma ismi nin üstünde yetkili şahsın adı var.

Ben ltd/cadde/TEL:/FAX:/@ olan yerleri değiştirerek bir kaç varyasyon denedim. Ancak olmadı.

Şu şekilde yeniden toparlasam acaba son bir deneme daha yapabilirmiyiz?

Aralardaki boşlukları ben silebiliyorum, yada boş satırlar önemli değil.
Her kayıtta @ işareti en altta bulunuyor.

Yani @ işaretinden sonra yeni satır atmalı. Bazı firma bilgileri 6, bazıları 7 ve bazıları da 8 satırdan oluşuyor. Ama @ işareti en sonra hep var.

@ işaretinin de olduğu satır dahil bir kayıt,
sonrası yeni bir kayıt yeni bir satır. Taaki @ işaretine kadar.

Mümkünmüdür ?
 
Selamlar,

Sn. hasbehas,

Siz bana veril kümelerindeki detayları verebilirseniz kodu ona göre düzenleyebiliriz.

6 satırlık veri kümesi için örneklersek;

Veri kümesinin 1. satırı hep firma adı içeriyor.
Veri kümesinin 2. satırı hep cadde adı içeriyor.
Veri kümesinin 3. satırı hep posta kodunu içeriyor.
Veri kümesinin 4. satırı hep ilçe-il adı içeriyor.
Veri kümesinin 5. satırı hep telefon no içeriyor.
Veri kümesinin 6. satırı hep mail adresi içeriyor.


7 satırlık veri kümesi için örneklersek;

Veri kümesinin 1. satırı hep firma adı içeriyor.
Veri kümesinin 2. satırı hep cadde adı içeriyor.
Veri kümesinin 3. satırı hep posta kodunu içeriyor.
Veri kümesinin 4. satırı hep ilçe-il adı içeriyor.
Veri kümesinin 5. satırı hep telefon no içeriyor.
Veri kümesinin 6. satırı hep faks no içeriyor.
Veri kümesinin 7. satırı hep mail adresi içeriyor.


8 satırlık veri kümesi için örneklersek;

Veri kümesinin 1. satırı hep firma adı içeriyor.
Veri kümesinin 2. satırı hep cadde adı içeriyor.
Veri kümesinin 3. satırı hep sokak adı içeriyor.
Veri kümesinin 4. satırı hep posta kodunu içeriyor.
Veri kümesinin 5. satırı hep ilçe-il adı içeriyor.
Veri kümesinin 6. satırı hep telefon no içeriyor.
Veri kümesinin 7. satırı hep faks no içeriyor.
Veri kümesinin 8. satırı hep mail adresi içeriyor.

Yani bu işlem için veri kümelerindeki sıralama önemlidir. Eğer karışık derseniz bu seferde veri içinde kullanabileceğimiz bir kriter olmalı ki (LTD,CADDE,SOK gibi) sağlıklı düzenleme yapabilelim.
 
Kod:
6 satırlık veri kümesi için örneklersek;

Veri kümesinin 1. satırı hep FirmaAdı adı içeriyor.
Veri kümesinin 2. satırı hep Adres içeriyor.
Veri kümesinin 3. satırı hep Adres içeriyor.
Veri kümesinin 4. satırı hep telefon içeriyor.
Veri kümesinin 5. satırı hep Fax içeriyor.
Veri kümesinin 6. satırı hep mail adresi içeriyor.


7 satırlık veri kümesi için örneklersek;

Veri kümesinin 1. satırı hep firma adı içeriyor.
Veri kümesinin 2. satırı hep adres adı içeriyor.
Veri kümesinin 3. satırı hep adres içeriyor.
Veri kümesinin 4. satırı hep telefon adı içeriyor.
Veri kümesinin 5. satırı hep fax no içeriyor.
Veri kümesinin 6. satırı hep website içeriyor.
Veri kümesinin 7. satırı hep mail adresi içeriyor.


8 satırlık veri kümesi için örneklersek;

Veri kümesinin 1. satırı hep yetkili içeriyor.
Veri kümesinin 2. satırı hep frmaadı adı içeriyor.
Veri kümesinin 3. satırı hep adres adı içeriyor.
Veri kümesinin 4. satırı hep adres içeriyor.
Veri kümesinin 5. satırı hep telefon adı içeriyor.
Veri kümesinin 6. satırı hep fax no içeriyor.
Veri kümesinin 7. satırı hep website içeriyor.
Veri kümesinin 8. satırı hep mail adresi içeriyor.

Küçük bir detay belirteyim,

Yukarıdan aşağıya sıralama değişebiliyor.
Örneğin 7 Sıralı bir veride
----------
Veri kümesinin 1. satırı hep yetkili adı içeriyor.
Veri kümesinin 2. satırı hep firma adı içeriyor.
Veri kümesinin 3. satırı hep adres adı içeriyor.
Veri kümesinin 4. satırı hep adres içeriyor.
Veri kümesinin 5. satırı hep telefon adı içeriyor.
Veri kümesinin 6. satırı hep fax no içeriyor.
Veri kümesinin 7. satırı hep mail adresi içeriyor.
----------
de olabiliyor.

mail adresinde doğal olarak @ işareti hep var.
Websitesi var ise: Mutlaka "Website:" şeklinde bi prefixi var. "Website:www.bilmemne.com" şeklinde.
Aynı şekilde Telefon ve fax da da "Phone:" ve "Fax:" şeklinde prefixler var.

Kod:
Michael Vieira
Colwood Hotels & Resorts Worldwide, Inc.
2155 Oswald Ave Ste 300
Honolulu HI, 
Phone: 801-926-4434
Fax: 801-993-0871
Website: www.coldwood.com
michael.vieira@coldwoodhotels.com

6-7 satırlı olan da Yetkili ismi olmayabiliyor.
Websitesi olmayabiliyor. Yada ikisi birden. Ama email adresi yoksa saten siliyoruz.


Umarım daha fazla yardımcı olabilmişimdir.

Ayrıca tüm çabalarınızdan dolayı çok teşekkür ediyorum.
 
Selamlar,

Aşağıdaki kode denermisiniz.

Önceki mesajımda da belirttiğim gibi ayırt edici bir ibare olmadığı sürece ve verilerin karışık dizilimleri olduğu sürece makro kullansanızda kolay çözüm üretemezsiniz. Makronun sağlıklı çalışabilmesi için bir düzen olmalıdır. Özellikle 7 satırlık veri dizilerinizde hatalar oluşabilir. İnceleyin yapılmasını istediğiniz eklemeler olursa kodu yeniden düzenleyebiliriz.

Tam çözüm olmadığı için açıkçası kod içime sinmedi. Umarım işinize yarar.

Kod:
Option Explicit
 
Sub VERİLERİ_DÜZENLE()
    Dim S1 As Worksheet
    Dim S2 As Worksheet
    Dim X As Long, Y As Long
    Dim Ara_Satır As Long, Satır As Long
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    S2.Cells.Clear
    Satır = 1
    
    For X = 1 To S1.Range("A65536").End(3).Row
        If S1.Cells(X, 1) <> "" Then
            Ara_Satır = S1.Cells(X, 1).End(4).Row
            If Ara_Satır = 65536 Then GoTo Devam
            If InStr(1, Cells(Ara_Satır, 1), "@", vbTextCompare) = 0 Then GoTo Devam
            
            Select Case (Ara_Satır - X + 1)
                Case Is = 6
                    S2.Cells(Satır, 1) = S1.Cells(X, 1)
                    S2.Cells(Satır, 2) = S1.Cells(X + 1, 1)
                    S2.Cells(Satır, 3) = S1.Cells(X + 2, 1)
                    S2.Cells(Satır, 4) = S1.Cells(X + 3, 1)
                    If InStr(1, S1.Cells(X + 4, 1), "PHONE", vbTextCompare) > 0 Then
                        S2.Cells(Satır, 5) = S1.Cells(X + 4, 1)
                    End If
                    If InStr(1, S1.Cells(X + 4, 1), "FAX", vbTextCompare) > 0 Then
                        S2.Cells(Satır, 6) = S1.Cells(X + 4, 1)
                    End If
                    S2.Cells(Satır, 7) = S1.Cells(X + 5, 1)
                    
                Case Is = 7
                    S2.Cells(Satır, 1) = S1.Cells(X, 1)
                    S2.Cells(Satır, 2) = S1.Cells(X + 1, 1)
                    S2.Cells(Satır, 3) = S1.Cells(X + 2, 1)
                    S2.Cells(Satır, 4) = S1.Cells(X + 3, 1)
                    If InStr(1, S1.Cells(X + 4, 1), "PHONE", vbTextCompare) > 0 Then
                        S2.Cells(Satır, 5) = S1.Cells(X + 4, 1)
                    End If
                    If InStr(1, S1.Cells(X + 5, 1), "FAX", vbTextCompare) > 0 Then
                        S2.Cells(Satır, 6) = S1.Cells(X + 5, 1)
                    End If
                    S2.Cells(Satır, 7) = S1.Cells(X + 6, 1)
                    
                Case Is = 8
                    S2.Cells(Satır, 1) = S1.Cells(X + 1, 1)
                    S2.Cells(Satır, 2) = S1.Cells(X + 2, 1)
                    S2.Cells(Satır, 3) = S1.Cells(X + 3, 1)
                    S2.Cells(Satır, 4) = S1.Cells(X + 4, 1)
                    If InStr(1, S1.Cells(X + 5, 1), "PHONE", vbTextCompare) > 0 Then
                        S2.Cells(Satır, 5) = S1.Cells(X + 5, 1)
                    End If
                    If InStr(1, S1.Cells(X + 6, 1), "FAX", vbTextCompare) > 0 Then
                        S2.Cells(Satır, 6) = S1.Cells(X + 6, 1)
                    End If
                    S2.Cells(Satır, 7) = S1.Cells(X + 7, 1)
                End Select

Devam:
        Satır = S2.Range("A65536").End(3).Row + 1
        X = Ara_Satır
        End If
    Next
    
    S2.Select
    
    Set S1 = Nothing
    Set S2 = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Tüm ilginiz ve alaknız için çok teşekkür ederim.
Ancak son kod da işe yaramadı.
Bizde manuel düzeltme için 3 arkadaşı görevlendirdik.
Tekrar çok teşekküler.
 
YatayAra Yazi Karakteri tasir mi?

Arkadaslar herkese merhaba,
Ekteki dosyada sag taraftaki hucrede Symbol karakteri ile yazilmis olan harfi, yatayara komutu ile sola tasidigim zaman bu karakterler arial a donusuyor. Yatayara komutu ayni karakter ile tasimaya musade etmiyor mu? Bu islemi nasil gerceklestirebilirim?

Not: Yeni bir baslik nasil acilir bulamadigim icin buraya cevap gibi yazmak zorunda kaldim.

Tesekkurler
Iyi calismalar
 

Ekli dosyalar

Geri
Üst