• DİKKAT

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

Sayfadaki Tüm Boşlukları Silme

S

sdn123

Katılım
30 Kasım 2011
Mesajlar
133
Excel Vers. ve Dili
2007 türkçe
Merhaba arkadaşlar;

bir Excel sayfasında hücrelerin içinde boşluklar var. KIRP formülü işe yaramıyor. Diğer formülerde kimi hücrelerde işe yararken kiminde yaramıyor.

Yardımcı olmanızı istediğim şey ise verileri bir çalışma sayfasında nereye yapıştırırsam yapıştırayım hücre içindeki boşlukları silecek bir makro
Yardımlarınız için şimdiden teşekkürler
 
Boşluk içeren 50 satırlık bir örnek dosya paylaşırsanız çözüm için yardımcı olacaktır.
 
Bazen metnin içinde gizli karakterler olabiliyor. Aşağıdaki formülle birçoğu temizleniyor ancak Korhan Bey'in dediği gibi örnek dosyanızı yüklerseniz daha net bir sonuç alabilirsiniz.
Kod: 
=KIRP(TEMİZ(YERİNEKOY(A1;DAMGA(160);"")))
 
Pratik bir yöntem de şudur :

Hücre içindeki temizlenemeyen, aslında standart boşluk olmayan boşluk karakterini kopyalayın.
Hücreden çıkıp CTRL+H ile Bul/Değiştir menüsünü açın.
Aranan kısmına kopyalanan boşluğu yapıştırın
Yeni değer kısmını boş bırakın
Tümünü değiştir deyin

Eğer bu boşluklar yanyana birden fazla ise ve ardışık olanlardan bir tanesinin hücre içinde kalması gerekiyorsa bu işlemde aranan kısmına iki tane boşluk yapıştırın, yeni değer kısmına bir tane yapıştırın. Tümünü değiştir düğmesine tüm fazlalıklar temizleninceye kadar üstüste basın.
 
dostlar ilginiz için teşekkürler. ama söyledğiniz yöntemlerin hiç biri yaramadı maalisef. istediğiniz dosyayı ekte ekliyorum.

İndir nıokta

Dosyayı indir nıokta
dosya.co
 
Dosyanız hazırdır. https://s2.dosya.tc/server12/6mbb5x/GizliKarakterler.xlsm.html
Kod: 
Sub chngValue()

    Dim str, stn As Integer
    Dim rng, cell As Range

    str = Cells(Rows.Count, 1).End(xlUp).Row
    stn = Cells(1, Columns.Count).End(xlToLeft).Column

    Set rng = Range(Cells(1, 1), Cells(str, stn))
        For Each cell In rng
            If InStr(cell, Chr(160)) <> 0 Or InStr(cell, " ") <> 0 Then
                cell = Application.Substitute(cell, Chr(160), "")
                cell = Application.Substitute(cell, " ", "")
            End If
        Next
        
    MsgBox "Gizli karakterler temizlendi"
End Sub
 
sdn123' Alıntı:
dostlar ilginiz için teşekkürler. ama söyledğiniz yöntemlerin hiç biri yaramadı maalisef. istediğiniz dosyayı ekte ekliyorum.

İndir nıokta

Dosyayı indir nıokta
dosya.co
Genişletmek için tıkla ...

YUSUF44'ün yöntemini sanırım yapamadınız. Yapsaydınız sorunun çözüldüğünü görecektiniz.

Başka bir yöntem
Ctrl+H
Aranan Alt+0160
Yeni değere hiç bir şey yazmayın
Tümünü Değiştir
 
Bu yöntem bazı hücrelerde işe yaradı. ama çoğunda işe yaramadı. Doğru,tüm boşluklar silindi ama yine toplama işlemini gerçekleşmedi...
 
genesis_vision' Alıntı:
Dosyanız hazırdır. https://s2.dosya.tc/server12/6mbb5x/GizliKarakterler.xlsm.html
Kod: 
Sub chngValue()

    Dim str, stn As Integer
    Dim rng, cell As Range

    str = Cells(Rows.Count, 1).End(xlUp).Row
    stn = Cells(1, Columns.Count).End(xlToLeft).Column

    Set rng = Range(Cells(1, 1), Cells(str, stn))
        For Each cell In rng
            If InStr(cell, Chr(160)) <> 0 Or InStr(cell, " ") <> 0 Then
                cell = Application.Substitute(cell, Chr(160), "")
                cell = Application.Substitute(cell, " ", "")
            End If
        Next
       
    MsgBox "Gizli karakterler temizlendi"
End Sub
Genişletmek için tıkla ...
hocam form denetimi yapıp bu makroyu atadığımda " If InStr(cell, Chr(160)) <> 0 Or InStr(cell, " ") <> 0 Then" kısmı için hata veriyor....
 
Bir de şu şekilde deneyiniz.
Kod: 
Sub chngValue()

    Dim str, stn As Integer
    Dim rng, cell As Range

    str = Cells(Rows.Count, 1).End(xlUp).Row
    stn = Cells(1, Columns.Count).End(xlToLeft).Column

    Set rng = Range(Cells(1, 1), Cells(str, stn))
        For Each cell In rng
            If InStr(1, cell, Chr(160)) <> 0 Then
                cell = Application.Substitute(cell, Chr(160), "")
            ElseIf InStr(1, cell, " ") <> 0 Then
                cell = Application.Substitute(cell, " ", "")
            End If
        Next
     
    MsgBox "Gizli karakterler temizlendi"
End Sub
 
Aşağıdaki formülü S1 e yapıştırıp,
aşağı doğru çoğaltın.
=SOLDAN(K1;BUL(" ";K1;1)-1)*1
Yada kendi formülünüzün sonuna *1 ekleyin.
 
sdn123' Alıntı:
Bu yöntem bazı hücrelerde işe yaradı. ama çoğunda işe yaramadı. Doğru,tüm boşluklar silindi ama yine toplama işlemini gerçekleşmedi...
Genişletmek için tıkla ...
Önceki sorunuz boşlukların temizlenmesiydi ve dediğinize göre bu işe yaramış, sorunu çözmüş. Toplama ile ilgili bir sorundan bahsetmemiştiniz. Bilmediğimiz bir soruna çözüm bulamayız doğal olarak.
 
Arkadaşımızın gönderdiği dosyada iki sorun da kalkmıştı benim denediğimde.
 
genesis_vision' Alıntı:
Dosyanız hazırdır. https://s2.dosya.tc/server12/6mbb5x/GizliKarakterler.xlsm.html
Kod: 
Sub chngValue()

    Dim str, stn As Integer
    Dim rng, cell As Range

    str = Cells(Rows.Count, 1).End(xlUp).Row
    stn = Cells(1, Columns.Count).End(xlToLeft).Column

    Set rng = Range(Cells(1, 1), Cells(str, stn))
        For Each cell In rng
            If InStr(cell, Chr(160)) <> 0 Or InStr(cell, " ") <> 0 Then
                cell = Application.Substitute(cell, Chr(160), "")
                cell = Application.Substitute(cell, " ", "")
            End If
        Next
       
    MsgBox "Gizli karakterler temizlendi"
End Sub
Genişletmek için tıkla ...

Kodlar başka bir Excel sayfasında mükemmel bir şekilde çalıştı. Ama asıl çalışma excelimde yine hata verdi. Asıl çalışma excelimi burada paylaşamıyorum çünkü kişisel veriler var.

Ama bu kez asıl excelde çalışmasındaki diğer tüm sayfaları silerek sadece kodların çalışacağı sayfayı gönderiyorum. Vakit ayırıp bir incelerseniz çok memnun olurum. Kafayı yemek üzereyim.

İndir den1

Dosyayı indir den1
dosya.co
 
sdn123' Alıntı:
Kodlar başka bir Excel sayfasında mükemmel bir şekilde çalıştı. Ama asıl çalışma excelimde yine hata verdi. Asıl çalışma excelimi burada paylaşamıyorum çünkü kişisel veriler var.

Ama bu kez asıl excelde çalışmasındaki diğer tüm sayfaları silerek sadece kodların çalışacağı sayfayı gönderiyorum. Vakit ayırıp bir incelerseniz çok memnun olurum. Kafayı yemek üzereyim.

İndir den1

Dosyayı indir den1
dosya.co
Genişletmek için tıkla ...
Kod: 
Option Explicit
Sub Bosluk_Sil()
On Error Resume Next
    Dim Veri As Variant, Son As Long, X As Long, Y As Byte, Zaman As Double

    Zaman = Timer

    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A8:AH" & Son).Value

    ReDim Liste(1 To UBound(Veri), 1 To 32)

    For X = 1 To UBound(Veri)
        For Y = 1 To 32
            Liste(X, Y) = Trim(Replace(Veri(X, Y), Chr(160), ""))
        Next
    Next

    Range("A8").Resize(X - 1, 32) = Liste

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
 
Aralık belirleme işlemini gönderdiğiniz eski sayfa üzerinden yapmıştım. Eski sayfa yapısıyla şimdi gönderdiğiniz sayfa yapısı arasında epey bir fark var. Haliyle kodlar hata veriyor. En son gönderdiğiniz örnek üzerinden düzenledim. Deneyiniz.

Sub chngValue()

Dim str, stn As Integer
Dim rng, cell As Range

str = Cells(Rows.Count, 1).End(xlUp).Row
stn = Cells(7, Columns.Count).End(xlToLeft).Column

Set rng = Range(Cells(8, 1), Cells(str, stn))
For Each cell In rng
If InStr(1, cell, Chr(160)) <> 0 Then
cell = Application.Substitute(cell, Chr(160), "")
ElseIf InStr(1, cell, " ") <> 0 Then
cell = Application.Substitute(cell, " ", "")
End If
Next

MsgBox "Gizli karakterler temizlendi"
End Sub
 
Son düzenleme:
Merhaba @sdn123

Bu şekilde dener misiniz.
Kod: 
Sub temiz()
For Each hcr In Range("A8:" & Cells.SpecialCells(xlLastCell).Address).SpecialCells(xlCellTypeConstants, 23)
    hcr.Value = Replace(Replace(hcr.Value, Chr(160), ""), " ", "")
Next
End Sub
 
sdn123' Alıntı:
Kodlar başka bir Excel sayfasında mükemmel bir şekilde çalıştı. Ama asıl çalışma excelimde yine hata verdi. Asıl çalışma excelimi burada paylaşamıyorum çünkü kişisel veriler var.

Ama bu kez asıl excelde çalışmasındaki diğer tüm sayfaları silerek sadece kodların çalışacağı sayfayı gönderiyorum. Vakit ayırıp bir incelerseniz çok memnun olurum. Kafayı yemek üzereyim.

İndir den1

Dosyayı indir den1
dosya.co
Genişletmek için tıkla ...

Kişisel verileri boş verin siz, sözünü ettiğiniz rakamları içeren verileri kopyalayıp bir başka dosyaya aktarın o dosya üzerinde kafa yoracak arkadaşlar uğraşsın.
Sorunu lafla anlamak olası değil.
 
Genel bir konuyu ilgilendiren duruma ait sorun.

Bu kodu çalışma sayfasına uygulayın.Verilen yanıtların dışında alternatif olsun.

Sub trimspc()

Dim c As Range, rngConstants As Range
On Error Resume Next
Set rngConstants = ActiveSheet.UsedRange.SpecialCells(2, 2)
On Error GoTo 0
If Not rngConstants Is Nothing Then
' performance
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'char 160
For Each c In rngConstants
c.Value = Trim$(Application.Clean(Replace(c.Value, Chr(160), " ")))
Next c
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End If
End Sub

K ve N sütunlarınız boşluk içeriyor gibi. AE ve AH kolonlarıda keza öyle. Onun dışında bir toplamaya engel olacak unsur yok gibi.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst