Sadece 15-TL bedelle DEV Excel Arşivine sahip olmak için DEV Excel Arşivi linkine tıklamanız yeterli olacaktır.

Çözüldü Ad Soyad Kırpma

MESKO

Yeni Üye
Üye
Katılım
2 Eki 2018
Mesajlar
29
En iyi cevap
0
Tepkime puanı
17
Puanları
3
Merhabalar;

Şöyle bir makro koduna ihtiyacım var. Yardımlarınızı rica edeceğim.

Sütunda isim ve soyisimler var.
1- İsim 2 boşluk Soyisim

2- İsim 1 boşluk İkinci isim 2 boşluk Soyisim

2 boşluğu 1 boşluğa çevirmek istiyorum.

Saygılar.
İyi Çalışmalar.
 

AhmetRasim

Destek Takımı
Destek Takımı
Katılım
15 Eki 2018
Mesajlar
47
En iyi cevap
1
Tepkime puanı
42
Puanları
18
Excel Versiyonu, Dili
Excel 2019 TR
Merhabalar;
Örnek olarak şu kodları deneyiniz.
A sütununda olan isimleri B sütununa yazar.
Kod:
Sub kırp_formulu()
For x = 2 To Cells(Rows.Count, "A").End(3).Row
Cells(x, "B") = Application.WorksheetFunction.Trim(Cells(x, "A"))
Next x
End Sub
Ek olarak; -İsimleri olduğu hücrelerde değiştirmek için;
Sayfada tıkladığınız hücrelerdeki fazla boşlukları silmek için şu şekilde de kullanabilirsiniz.
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target = Application.WorksheetFunction.Trim(Target)
End Sub
Sayfa aktif olduğunda A sütunundaki isimlerin fazla boşluklarını siler;
Kod:
Private Sub Worksheet_Activate()
For x = 1 To Cells(Rows.Count, "A").End(3).Row
Cells(x, "A") = Application.WorksheetFunction.Trim(Cells(x, "A"))
Next x
End Sub
Kod:
Sub kırp_formulu()
For x = 1 To Cells(Rows.Count, "A").End(3).Row
Cells(x, "A") = Application.WorksheetFunction.Trim(Cells(x, "A"))
Next x
End Sub
 
Son düzenleme:

MESKO

Yeni Üye
Üye
Katılım
2 Eki 2018
Mesajlar
29
En iyi cevap
0
Tepkime puanı
17
Puanları
3
Merhabalar;
Örnek olarak şu kodları deneyiniz.
A sütununda olan isimleri B sütununa yazar.
Kod:
Sub kırp_formulu()
For x = 2 To Cells(Rows.Count, "A").End(3).Row
Cells(x, "B") = Application.WorksheetFunction.Trim(Cells(x, "A"))
Next x
End Sub
Sayın Ahmet Rasim Bey;
Çok teşekkür ederim.
Uygulamama adapte edeceğim.
 

AhmetRasim

Destek Takımı
Destek Takımı
Katılım
15 Eki 2018
Mesajlar
47
En iyi cevap
1
Tepkime puanı
42
Puanları
18
Excel Versiyonu, Dili
Excel 2019 TR
Merhabalar;
Rica ederim.
Saygılarımla, iyi çalışmalar.
 

MESKO

Yeni Üye
Üye
Katılım
2 Eki 2018
Mesajlar
29
En iyi cevap
0
Tepkime puanı
17
Puanları
3
Merhabalar;
Rica ederim.
Saygılarımla, iyi çalışmalar.
Sayın Ahmet Rasim Bey;

Verdiğiniz kodu ADO ile kapalı dosyadan bilgileri çektikten sonra çalıştırdığımda doğru sonuç veriyor.

Fakat; Cells(i, 6) = Trim(rs("İSİM").Value) satırı ADO döngüsü içerisinde doğru sonuç vermiyor.

:unsure:
Saygılarımla.
 

AhmetRasim

Destek Takımı
Destek Takımı
Katılım
15 Eki 2018
Mesajlar
47
En iyi cevap
1
Tepkime puanı
42
Puanları
18
Excel Versiyonu, Dili
Excel 2019 TR
Merhabalar;
Kullandığınız kodları içeren ve çalışma dosyanıza uygun Örnek dosyaları ekler misiniz? İlk fırsatta bakmaya çalışırım, ya da arkadaşlar daha hızlı çözüm sunarlar. 😊
 

MESKO

Yeni Üye
Üye
Katılım
2 Eki 2018
Mesajlar
29
En iyi cevap
0
Tepkime puanı
17
Puanları
3
Merhabalar;
Kullandığınız kodları içeren ve çalışma dosyanıza uygun Örnek dosyaları ekler misiniz? İlk fırsatta bakmaya çalışırım, ya da arkadaşlar daha hızlı çözüm sunarlar. 😊
Merhabalar
İlgili dosya ektedir.
F sütununda ADO döngüsü içerisinde trim çalışmıyor.

Saygılar.
İyi Çalışmalar.
 

Ekli dosyalar

AhmetRasim

Destek Takımı
Destek Takımı
Katılım
15 Eki 2018
Mesajlar
47
En iyi cevap
1
Tepkime puanı
42
Puanları
18
Excel Versiyonu, Dili
Excel 2019 TR
Merhabalar;
ADO ile kayıt aldığında denedim, bazı örnekleri de inceledim ama dediğiniz gibi olmadı.
Kırpma işlemi için ayrı bir döngü kurunca oluyor. İşlemin sonunda ya da satırlara kayıt alırken.

Örnek olarak, satırlara kayıt aldıkça kırpma işlemini yapması için;
For i = 2 To Cells(Rows.Count, 3).End(xlUp).Row satırından sonra For x = 1 To Cells(Rows.Count, "F").End(3).Row satrını;

Next i satırından öncede
Cells(x, "F") = Application.WorksheetFunction.Trim(Cells(x, "F"))
Next x
satırlarını ekleyiniz.

Her satıra kayıt aldığında işlem yapacağı için biraz zaman alabilir. Bu işlemin zaman almaması için döngü kayıtlardan sonra çalıştırılmalı.

ADO ile kayıt sırasındaki işlemde yardımcı olamadım kusura bakmayın. Konuya hakim arkadaşlar yardımcı olduğunda, sizin aracılığınız ile bende öğrenmiş olacağım.:)

Saygılarımla, iyi çalışmalar.
 

MESKO

Yeni Üye
Üye
Katılım
2 Eki 2018
Mesajlar
29
En iyi cevap
0
Tepkime puanı
17
Puanları
3
Merhabalar;
ADO ile kayıt aldığında denedim, bazı örnekleri de inceledim ama dediğiniz gibi olmadı.
Kırpma işlemi için ayrı bir döngü kurunca oluyor. İşlemin sonunda ya da satırlara kayıt alırken.

Örnek olarak, satırlara kayıt aldıkça kırpma işlemini yapması için;
For i = 2 To Cells(Rows.Count, 3).End(xlUp).Row satırından sonra For x = 1 To Cells(Rows.Count, "F").End(3).Row satrını;

Next i satırından öncede
Cells(x, "F") = Application.WorksheetFunction.Trim(Cells(x, "F"))
Next x
satırlarını ekleyiniz.

Her satıra kayıt aldığında işlem yapacağı için biraz zaman alabilir. Bu işlemin zaman almaması için döngü kayıtlardan sonra çalıştırılmalı.

ADO ile kayıt sırasındaki işlemde yardımcı olamadım kusura bakmayın. Konuya hakim arkadaşlar yardımcı olduğunda, sizin aracılığınız ile bende öğrenmiş olacağım.:)

Saygılarımla, iyi çalışmalar.
Emeğinize , ilginize çok teşekkür ederim.
Biz daha yeniyiz sizlerden öğreneceğimiz çok şey var.

Saygılar
İyi çalışmalar.
 

AhmetRasim

Destek Takımı
Destek Takımı
Katılım
15 Eki 2018
Mesajlar
47
En iyi cevap
1
Tepkime puanı
42
Puanları
18
Excel Versiyonu, Dili
Excel 2019 TR
Merhabalar;
Rica ederim, bende öğrenme aşamasındayım. :)
Hep birlikte öğrenmeye devam. :)(y)
Saygılarımla, iyi çalışmalar.
 

Ömer BARAN

Kurucu
Yönetici
Kurucu
Katılım
11 Nis 2019
Mesajlar
127
En iyi cevap
0
Tepkime puanı
96
Puanları
28
Excel Versiyonu, Dili
2013 (32) TR
Merhaba.
Alternatif olsun.
Basitçe, Ms.Excel'in CTRL+H işlemi de aynı sonucu vermez mi? Ayrıca bu işlem de zaman almaz.
Rich (BB code):
Sheets("sayfa adı").Range("F2:F" & Sheets("sayfa adı").Cells(Rows.Count, "F").End(3).Row).Replace What:="  ", Replacement:=" "
 

bzace

Yeni Üye
Üye
Katılım
30 Nis 2019
Mesajlar
7
En iyi cevap
0
Tepkime puanı
7
Puanları
3
Konum
İstanbul
Merhabalar,
Alternatif olarak deneyebilir misiniz?

Kod:
Sub Boşluk_Sil()
    Dim i As Range
    For Each i In ActiveSheet.UsedRange.SpecialCells(2).Areas
        i = Application.Trim(i)
    Next
End Sub
 

PriveT

İlyas
Destek Takımı
Katılım
26 Nis 2019
Mesajlar
93
En iyi cevap
1
Tepkime puanı
47
Puanları
18
Konum
Alanya & Moskova
Excel Versiyonu, Dili
Excel 2016 TR
Merhaba,
Değiştirden (ctrl+H) aranan değere 2 boşluk, yeni değere 1 boşluk koyup hepsini değiştir demeyi denediniz mi?
 

MESKO

Yeni Üye
Üye
Katılım
2 Eki 2018
Mesajlar
29
En iyi cevap
0
Tepkime puanı
17
Puanları
3
Emeği geçen herkese teşekkür ederim.
Yeni cevapları arşivime ekleyeceğim.

Hayırlı Ramazanlar.
Saygılarımla.
 

Üst