Boşlukları silmek için Makro koda ihtiyacım var.

[margenprice]

Merhaba
excell de sütündaki tüm text içeriğinde bulunan boşlukları silmeye ihtiyacım var. tek boşluk doğal ama yazılar arasında tek boşluktan fazla olmaması gerekiyor. Yani açıklama a açıklama b (boşluk boşluk boşluk) . Açıklama c "b" ile "açıklama" arasının tek boşluk olarak güncellenmesi lazım.

Veri büyük olduğundan el ile yapmak zor bu işi. a1,a2,a3 diye tüm sütunlara uygulamasını istiyorum. Forumu yeni keşfettim ve önceki konu başlığıma hemen faydalı cevap aldım. teşekkür ederim şimdiden.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Kirp()
    
    Dim i As Long
    
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        Cells(i, "A") = Evaluate("=Trim(" & Cells(i, "A").Address & ")")
    Next i
    
End Sub

.

 

[cems]

Büyük veriyi değil ama küçük bir birebir örneğini www.dosya.tc üzerinden yükleyip burada link verirseniz , hücre yerleri tahmini olmadan daha doğru bir çözüm üretilebilir.

 

[margenprice]

Merhaba,

Bu şekilde deneyin.

Sub Kirp()
    
    Dim i As Long
    
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        Cells(i, "A") = Evaluate("=Trim(" & Cells(i, "A").Address & ")")
    Next i
    
End Sub

.

Yanıt için teşekkürler. Linkteki gibi oldu maalesef. http://prntscr.com/eqib76

 

[margenprice]

Büyük veriyi değil ama küçük bir birebir örneğini www.dosya.tc üzerinden yükleyip burada link verirseniz , hücre yerleri tahmini olmadan daha doğru bir çözüm üretilebilir.

link aşağıdadır. resimde görüldüğü gibi açıklamalar boşluklardan dolayı aşırı uzun olduğundan sistemde soruna yol açıyor.

http://prntscr.com/eqie3d

 

[Ömer]

Yanıt için teşekkürler. Linkteki gibi oldu maalesef. http://prntscr.com/eqib76

Bu şekilde hatalı sonuçlar aldığınız Excel dosyanızın küçük bir örneğini
www.dosya.tc sitesine yükleyip paylaşmanızı rica ederim.

.

 

[margenprice]

örnek link aşağıdadır. sayfa 1 de sadece işlemin yapılmasını istediğim açıklamalar sayfa 2 de ise makroyu uyguladığımda aldığım sonuç yer alıyor. Teşekkürler.

https://drive.google.com/file/d/0B3xBIKGJUBnqMG9ySlljaElsR2s/view?usp=sharing
aynı dosya hangisini tercih ederseniz
http://s6.dosya.tc/server8/fy9a8f/ornek_22.xlsx.html

 

[Ömer]

Bu şekilde deneyin.

Sub Kirp_Temizle()
    
    Dim i As Long, d As Object
    
    [A:A].Replace Chr(13), ""
    
    Set d = CreateObject("VBScript.RegExp")
    d.MultiLine = True
    d.Global = True
    d.Pattern = "^[\n]{1}"
    
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        Cells(i, "A") = Trim(d.Replace(Trim(Cells(i, "A")), ""))
    Next i
    
End Sub

.

 

[margenprice]

Bu şekilde deneyin.

Sub Kirp_Temizle()
    
    Dim i As Long, d As Object
    
    [A:A].Replace Chr(13), ""
    
    Set d = CreateObject("VBScript.RegExp")
    d.MultiLine = True
    d.Global = True
    d.Pattern = "^[\n]{1}"
    
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        Cells(i, "A") = Trim(d.Replace(Trim(Cells(i, "A")), ""))
    Next i
    
End Sub

.

Tüm kalbimle teşekkür ederim ömer bey.

 

[Ömer]

Rica ederim, iyi çalışmalar.