hücreye girilen veri 10 karakterden az ise rakkamların önüne sıfır koyarak 10 karakte

[numan şamil]

Merhaba Arkadaşlar
Excelde "A2:A" hücrelerindeki verileri bul değiştir kullanmadan makro ve bir buton yardımıyla
1) noktaları virgül yapacak kod varmı?
örn: yanlışlıkla 145.25.11 yazdığımızda 145,25,11 şeklinde düzeltebilecek kod
2) bu hücrelere girilen veriler 10 karakterden az olduğu zaman
Rakkamların önüne sıfır koyarak 10 karaktere tamamlayacak kod Örn:145,25 yazıldığında 0000145,25 şeklinde düzenleyecek kod gerekmektedir
herkese iyi çalışmalar

 

[asi_kral]

Merhaba
1. Sorunuzun cevabı boş bir module kopyalayın ve deneyin.

Option Explicit
Sub noktadalarvirgül()
Dim STR As Long
Application.ScreenUpdating = False
For STR = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(STR, "A") = Replace(Cells(STR, "A"), ".", ",")
Next
Application.ScreenUpdating = True
End Sub

2. Sorunuzun cevabı
Sayfanın kod bölümüne kopyalayın ve deneyin.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DGR As String
Application.EnableEvents = False
If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then _
Application.EnableEvents = True: Exit Sub
Select Case Len(Target)
Case "1": DGR = "000000000" & Target
Case "2": DGR = "00000000" & Target
Case "3": DGR = "0000000" & Target
Case "4": DGR = "000000" & Target
Case "5": DGR = "00000" & Target
Case "6": DGR = "0000" & Target
Case "7": DGR = "000" & Target
Case "8": DGR = "00" & Target
Case "9": DGR = "0" & Target
End Select
Target.NumberFormat = "@"
Target = DGR
Application.EnableEvents = True
End Sub

 

[numan şamil]

Sn asi kral ilginiz için teşekkürler
kodlarınızı denedim
ancak bir sorun ile karşılaştım
sorun verileri girdikten sonra bir kaçını seçip sildiğim zaman hata veriyor ve
bir daha çalışmıyor

Select Case Len(Target)

satırında hata veriyor
Ayrıca bu iki kod

Private Sub Worksheet_Change(ByVal Target As Range)

başlığında billeştirebilirmiyiz

Not:Ekli dosyada yukardaki şekilde denedim ilk önce kodlar çalıştı
birkaç veriyi toptan seçip silince bir daha çalışmıyor

 

[asi_kral]

Sn asi kral ilginiz için teşekkürler
kodlarınızı denedim
ancak bir sorun ile karşılaştım
sorun verileri girdikten sonra bir kaçını seçip sildiğim zaman hata veriyor ve
bir daha çalışmıyor

Select Case Len(Target)

satırında hata veriyor
Ayrıca bu iki kod

Private Sub Worksheet_Change(ByVal Target As Range)

başlığında billeştirebilirmiyiz

Seçip silmekten kastınız nedir.
Eğer ki A2:A5 aralığını tarayıp tamamen siliyorsanız ve içeriğini boşaltıyorsanız doğrudur bu hatayı verir. Çünkü kod tek satıra bakarak işlem yapıyor.

Hangi kodları Change olayında birleştireceğiz bunu anlamadım. Siz butonlu istemiştiniz botonda değilde hücre tetiklemesinde mi bu işlemi yapsın.

 

[numan şamil]

Seçip silmekten kastınız nedir.
Eğer ki A2:A5 aralığını tarayıp tamamen siliyorsanız ve içeriğini boşaltıyorsanız doğrudur bu hatayı verir. Çünkü kod tek satıra bakarak işlem yapıyor.

Hangi kodları Change olayında birleştireceğiz bunu anlamadım. Siz butonlu istemiştiniz botonda değilde hücre tetiklemesinde mi bu işlemi yapsın.

Dediğniz gibi A2:A5 aralığını tarayıp sildiğimizde hata veriyor
bu hatayı vermeyecek şekilde kodlar düzenlene bilinirmi?
olmuyorsa tarayıp silmeyi engelleyecek ve uyarı verecek kod ekleyebilirmiyiz
evet buton tetiklemesinde işlem yapsa daha iyi olur

 

[asi_kral]

Dediğniz gibi A2:A5 aralığını tarayıp sildiğimizde hata veriyor
bu hatayı vermeyecek şekilde kodlar düzenlene bilinirmi?
olmuyorsa tarayıp silmeyi engelleyecek ve uyarı verecek kod ekleyebilirmiyiz
evet buton tetiklemesinde işlem yapsa daha iyi olur

Bu kodu dener misiniz_?

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DGR As String
Application.EnableEvents = False
If Target.Count = 1 Then
If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then _
Application.EnableEvents = True: Exit Sub
Select Case Len(Target)
Case "1": DGR = "000000000" & Target
Case "2": DGR = "00000000" & Target
Case "3": DGR = "0000000" & Target
Case "4": DGR = "000000" & Target
Case "5": DGR = "00000" & Target
Case "6": DGR = "0000" & Target
Case "7": DGR = "000" & Target
Case "8": DGR = "00" & Target
Case "9": DGR = "0" & Target
End Select
Target.NumberFormat = "@"
Target = Replace(DGR, ".", ",")
End If
Application.EnableEvents = True
End Sub

Çoklu seçim yaptığınızda kod hata vermez ama çalışmaz da

 

[numan şamil]

Bu kodu dener misiniz_?

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DGR As String
Application.EnableEvents = False
If Target.Count = 1 Then
If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then _
Application.EnableEvents = True: Exit Sub
Select Case Len(Target)
Case "1": DGR = "000000000" & Target
Case "2": DGR = "00000000" & Target
Case "3": DGR = "0000000" & Target
Case "4": DGR = "000000" & Target
Case "5": DGR = "00000" & Target
Case "6": DGR = "0000" & Target
Case "7": DGR = "000" & Target
Case "8": DGR = "00" & Target
Case "9": DGR = "0" & Target
End Select
Target.NumberFormat = "@"
Target = Replace(DGR, ".", ",")
End If
Application.EnableEvents = True
End Sub

Çoklu seçim yaptığınızda kod hata vermez ama çalışmaz da

bu şekilde istediğm gibi oldu teşekkürler
iyi çalışmalar

 

[Necdet]

Merhaba,

Neden Özel Hücre Biçiminden A sütununu 0000000000 olarak biçimlendirmiyorsunuz?

 

[asi_kral]

bu şekilde istediğm gibi oldu teşekkürler
iyi çalışmalar

Kolay Gelsin.