Sütündaki yazının başındaki boşluğu tek seferde silme

[splashsmlt]

ekli dosyada I J K sütünlarındaki yazıların en başında ya bir boşluk ya da iki boşluk var. 11.500 satır olunca silmek zor oluyor bunu tek seferde silebilir miyiz. Ama sadecede CÜMLENİN BAŞINDAKİ BOŞLUĞU DİĞERLERİ DURMALI.

 

[vein03051976]

Merhabalar

KIRP formülü ile yapabilirsiniz

 

[splashsmlt]

Standart iki ya da bir boşluk yok ama. Bazı hücrelerde bir boşluk bazılarında 2 boşluk bazılarında da hiç boşluk yok

 

[muratb06]

ekli dosyada I J K sütünlarındaki yazıların en başında ya bir boşluk ya da iki boşluk var. 11.500 satır olunca silmek zor oluyor bunu tek seferde silebilir miyiz. Ama sadecede CÜMLENİN BAŞINDAKİ BOŞLUĞU DİĞERLERİ DURMALI.

Başka bir yere yüklerseniz, bakabilirim.

ASUS_Z00LD cihazımdan Tapatalk kullanılarak gönderildi

 

[splashsmlt]

Arkadaşlar çok kolay birşey belki ama ben yapamadım eğer bir yolu varsa yardımınızı istirham ediyorum.

 

[netzone]

Merhaba @splashsmlt,

Sorunuzun cevabı @vein03051976 tarafından zaten verilmiş. Ancak siz denemeden yorum yapmışsınız.
KIRP işlevi: Belirtilen hücrede bulunan metnin sadece başında ve sonundaki boşlukları kaldırır. Burada boşluk sayısı önemsizdir varsa kaldırır yoksa olduğu gibi bırakır. Yapmanız gereken; I, J, K sütunlarınızın kırpılması için yardımcı sütun kullanmanız. Araya 3 boş sütun açın ve hücreye formülü yazın (Örnek: J2 için =KIRP(J2) demeniz ve aşağı doğru çoğaltmanız yeterli.) Kırptıktan sonra atıl olan satırları silmeden önce Sütunları Kopyala > Özel yapıştır > Değerleri derseniz formülden kurtulmuş olur, referans silinmesi halinde bu hücrelerdeki veriyi kaybetmemiş olursunuz.

İyi çalışmalar.

 

[Seyit Tiken]

Bu kodla işlemlerinizi gerçekleştirebilirsiniz.

For s = 1 To Range("I65536").End(xlUp).Row
Range("I" & s).Value = Trim(Range("I" & s).Value)
Next
For ss = 1 To Range("j65536").End(xlUp).Row
Range("J" & ss).Value = Trim(Range("J" & ss).Value)
Next
For sss = 1 To Range("k65536").End(xlUp).Row
Range("k" & sss).Value = Trim(Range("k" & sss).Value)
Next

 

[Seyit Tiken]

Kodun kısaltmış hali

For s = [I65000].End(3).Row To 1 Step -1
Range("I" & s & ":k" & s).Value = Trim(Range("I" & s).Value)
Next

 

[İdris SERDAR]

.

Bu kodu deneyin.

Sub sil()

Dim x As Range
For Each x In ActiveSheet.UsedRange
    With x
        .Value = WorksheetFunction.Trim(.Value)
    End With
Next x

End Sub

.

 

[İdris SERDAR]

.

Veya bunu:

Sub sil()
Dim son As Long
Dim x As Range
With ActiveSheet
son = .Cells(.Rows.Count, "I").End(xlUp).Row
For Each x In ActiveSheet.Range("I2:K" & son)
    With x
        .Value = WorksheetFunction.Trim(.Value)
    End With
Next x
End With
End Sub

.

 

[splashsmlt]

tüm saygıdeğer üstadlara teşekkür ederim verdiğiniz bilgiler doğrultusunda hallettim. sağolun iyi varsınız

 

[5353]

Ekteki çalışma kitabında;
B C E gibi sütunlarda boşluklar var. CTRL+ H ile değiştiğimde bazıları tek bazıları birden fazla boşluk olduğundan rakam olarak görmüyor. Bu boşlukları makro vb. nasıl silebiliriz

 

[Korhan Ayhan]

Deneyiniz.

İşlem yapmak istediğiniz alanı seçip kodu çalıştırınız.

Option Explicit

Sub Bosluk_Temizle()
    Dim Rng As Range
    
    For Each Rng In Selection
        With Rng
            If Not IsError(.Value) Then
                If .Value <> "" And .HasFormula = False Then
                    .Value = WorksheetFunction.Substitute(.Value, ChrW(160), "")
                    .Value = WorksheetFunction.Trim(.Value)
                    If IsNumeric(.Value) Then
                        If InStr(1, .NumberFormat, "d") > 0 Then
                            .Value = CDate(.Value)
                        Else
                            .Value = CDbl(.Value)
                        End If
                    End If
                End If
            End If
        End With
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[5353]

Deneyiniz.

İşlem yapmak istediğiniz alanı seçip kodu çalıştırınız.

Option Explicit

Sub Bosluk_Temizle()
    Dim Rng As Range
   
    For Each Rng In Selection
        With Rng
            If Not IsError(.Value) Then
                If .Value <> "" And .HasFormula = False Then
                    .Value = WorksheetFunction.Substitute(.Value, ChrW(160), "")
                    .Value = WorksheetFunction.Trim(.Value)
                    If IsNumeric(.Value) Then
                        If InStr(1, .NumberFormat, "d") > 0 Then
                            .Value = CDate(.Value)
                        Else
                            .Value = CDbl(.Value)
                        End If
                    End If
                End If
            End If
        End With
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Çok teşekkür ederim ustad.