DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub bosluksil59()
Dim hcr As Range
For Each hcr In Range("A1:A50")
hcr.Value = Replace(hcr.Value, "*", "")
Next
MsgBox "Sağdaki boşluklar temizlendi." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, Application.UserName
End Sub
Buyurun kodları.Öncekini silin bunu yazın.Orion1 Kardeş,ilgin için teşekkür ederim.Ekteki dosyada kodu uygulağımda sondaki boşlukları silmedi.Mümkünse bakabilir misiniz?
Dim hcr As Range
For Each hcr In Range("A1:A50")
hcr.Value = Replace(Replace(hcr.Value, " ", ""), asc(160), "")
Next
MsgBox "Sağdaki boşluklar temizlendi." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, Application.UserName
Maalesef bu kodlada sondaki boşlukları silmedi.Örnek dosyada deneyebilir misiniz?Buyurun kodları.Öncekini silin bunu yazın.
Kod:Dim hcr As Range For Each hcr In Range("A1:A50") hcr.Value = Replace(Replace(hcr.Value, " ", ""), asc(160), "") Next MsgBox "Sağdaki boşluklar temizlendi." & vbLf & _ "evrengizlen@hotmail.com", vbOKOnly + vbInformation, Application.UserName
Sub bosluktemizle()
For a = 1 To [a65536].End(3).Row
Cells(a, "a") = CDbl(Cells(a, "a"))
Next
End Sub
Eğer verileriniz dosyanızdaki gibi sayısal ise aşağıdaki kodu deneyebilirsiniz.
Kod:Sub bosluktemizle() For a = 1 To [a65536].End(3).Row Cells(a, "a") = CDbl(Cells(a, "a")) Next End Sub
Dim hcr As Range
For Each hcr In Range("A1:A50")
hcr.Value = Replace(Replace(Replace(hcr.Value, " ", ""), Asc(160), ""), "*", "")
Next
MsgBox "Sağdaki boşluklar temizlendi." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, Application.UserName
Dim hcr As Range
For Each hcr In Range("A1:A50")
hcr.Value = Replace(Replace(Replace(Replace(hcr.Value, " ", ""), Asc(160), ""), "*", ""), "*", "")
Next
MsgBox "Sağdaki boşluklar temizlendi." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, Application.UserName
Sub BulDegistir1()
Set pDict = CreateObject("Scripting.Dictionary")
pDict.Add " ", ""
For Each p In pDict
Columns("A:A").Replace what:=p, replacement:=pDict.Item(p), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next
End Sub
ekli dosyada doğru çalışıyor.Orion1 Kardeş,
Eline sağlık kod gayet güzel çalışıyor.Yalnız çok denedim A sütununda hücrelere yazılan rakamlardan 49 olanlarını siliyor.Örnek:124949123 şeklindeki bir rakamı 12123 şekline dönüştürüyor.Aradaki 49'ları siliyor.