Çözüldü Ad Soyad Kırpma

MESKO

Yeni Üye
Üye
Katılım
2 Eki 2018
Mesajlar
29
Tepki puanı
17
Puanları
3
Excel Versiyonu, Dili
Bilinmiyor
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
50
Tepki puanı
47
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
Tepki puanı
17
Puanları
3
Excel Versiyonu, Dili
Bilinmiyor
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
50
Tepki puanı
47
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
Tepki puanı
17
Puanları
3
Excel Versiyonu, Dili
Bilinmiyor
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
50
Tepki puanı
47
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
Tepki puanı
17
Puanları
3
Excel Versiyonu, Dili
Bilinmiyor
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
50
Tepki puanı
47
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
Tepki puanı
17
Puanları
3
Excel Versiyonu, Dili
Bilinmiyor
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
50
Tepki puanı
47
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
151
Tepki puanı
109
Puanları
43
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
Tepki puanı
7
Puanları
3
Konum
İstanbul
Excel Versiyonu, Dili
Bilinmiyor
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
102
Tepki puanı
52
Puanları
28
Yaş
41
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
Tepki puanı
17
Puanları
3
Excel Versiyonu, Dili
Bilinmiyor
Emeği geçen herkese teşekkür ederim.
Yeni cevapları arşivime ekleyeceğim.

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

İlginizi Çekecek Benzer Konular

Üst