• DİKKAT

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

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

Katılım
18 Nisan 2017
Mesajlar
112
Excel Vers. ve Dili
2016 c++
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.
 

Ekli dosyalar

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
 
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
 
Arkadaşlar çok kolay birşey belki ama ben yapamadım eğer bir yolu varsa yardımınızı istirham ediyorum.
 
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.
 
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
 
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
 
.

Bu kodu deneyin.

Kod:
Sub sil()

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

End Sub

.
 
.

Veya bunu:

Kod:
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

.
 
tüm saygıdeğer üstadlara teşekkür ederim verdiğiniz bilgiler doğrultusunda hallettim. sağolun iyi varsınız
 
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
 

Ekli dosyalar

Deneyiniz.

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

C++:
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
 
Deneyiniz.

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

C++:
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.
 
Geri
Üst