• DİKKAT

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

Tek haneli rakamların başına sıfır değeri ekleme.

Katılım
16 Ocak 2009
Mesajlar
69
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2016 TR
Her ay artan A, B VE C sütunlarındaki değerlerin (bu ay 135.192 satırda), F sütununda örnek gösterdiğim değerler gibi tek haneli olan rakamların başına 0 (Sıfır) getirmek istiyorum. Makro veya formül ile yapılabir mi.
 

Ekli dosyalar

F sütunundali verilerin diğer sütunlarla bir bağı var mı?
F sütununa veriyi siz elle girdiğinizde sayı olan ve tek basamaklı tüm içeriklerin başına Sıfırı otomatik mi koysun?
Parantezleri de mi koysun?
F sütunan verileri elle tek tek mi giriyorsunuz başka bir yerden Copy-Paste yaparak mı?
 
F sütunundali verilerin diğer sütunlarla bir bağı var mı?
F sütununa veriyi siz elle girdiğinizde sayı olan ve tek basamaklı tüm içeriklerin başına Sıfırı otomatik mi koysun?
Parantezleri de mi koysun?
F sütunan verileri elle tek tek mi giriyorsunuz başka bir yerden Copy-Paste yaparak mı?

Ömer bey merhaba,
öncelikle ilgilendiğiniz için teşekkür ediyorum,
sistemden rapor aldığımda sütuların uzantısı, A Sütunundan X Sütununa kadar, ek dosyada sütun başlıklarını belirttim. olması gereken asıl sütunlar N, O ve Q sütunları.
F sütunundaki verilerin diğer sütunlar ile bir bağı yok ben örnek olarak gösterdim F sütununda.
F sütununa verileri elle girmiyorum, ama dediğiniz gibi tek basamaklı tüm içeriklerin başına sıfır otomatik koymasını istiyorum.
parantezlerde olması gerekiyor.
F sütunu ile bir bağım yok.
 

Ekli dosyalar

Hücre Biçimlendir ile yapabilirsiniz.

-Hücreleri Biçimlendir
-Sayı
-İsteğe Uyarlanmış
-0#
 
RegExp ile olur mu bilemedim. Beceremediğim bir konu.
Ancak aşağıdaki kodları bir Modüle içine yerleştirip sayfanızda çalıştırırsanız N-O-Q sütunlarında işlem yapmaktadır.
Çalıştırmadan önce dosyanın yedeğini almanızı tavsiye ederim.

C++:
Sub TekHaneleriDuzelt()
Dim Veri, ListeN, ListeO, ListeQ
Dim x As Byte, i As Long, k As Integer, xLen As Integer, Bak As String, Say As String, YeniDeger As String
    Veri = Range("N2:Q" & Range("N" & Rows.Count).End(3).Row).Value
    ReDim ListeN(1 To UBound(Veri), 1 To 1)
    ReDim ListeO(1 To UBound(Veri), 1 To 1)
    ReDim ListeQ(1 To UBound(Veri), 1 To 1)
    
    For x = 1 To 4
        If x = 3 Then x = 4
        For i = 1 To UBound(Veri)
            Bak = Veri(i, x)
            xLen = Len(Bak)
            YeniDeger = ""
            For k = 1 To xLen
                Say = Mid(Bak, k, 1)
                If IsNumeric(Mid(Bak, k, 1)) Then
                    If k = 1 And xLen = 1 Then
                        YeniDeger = YeniDeger & "0" & Say
                    ElseIf k = 1 And xLen > 1 And Not IsNumeric(Mid(Bak, 2, 1)) Then
                        YeniDeger = YeniDeger & "0" & Say
                    ElseIf k > 1 And xLen = 2 And Not IsNumeric(Left(Bak, 1)) Then
                        YeniDeger = YeniDeger & "0" & Say
                    ElseIf k > 1 And xLen > 2 And k < xLen And Not IsNumeric(Mid(Bak, k - 1, 1)) And Not IsNumeric(Mid(Bak, k + 1, 1)) Then
                        YeniDeger = YeniDeger & "0" & Say
                    ElseIf k = xLen And Not IsNumeric(Mid(Bak, k - 1, 1)) Then
                        YeniDeger = YeniDeger & "0" & Say
                    Else
                        YeniDeger = YeniDeger & Say
                    End If
                Else
                    YeniDeger = YeniDeger & Say
                End If

            Next k
            Select Case x
                Case 1
                ListeN(i, 1) = YeniDeger
                Case 2
                ListeO(i, 1) = YeniDeger
                Case Else
                ListeQ(i, 1) = YeniDeger
            End Select
        Next i
    Next x
    Range("N2").Resize(UBound(Veri), 1) = ListeN
    Range("O2").Resize(UBound(Veri), 1) = ListeO
    Range("Q2").Resize(UBound(Veri), 1) = ListeQ
    Erase Veri: Erase ListeN: Erase ListeO: Erase ListeQ
End Sub
 
RegExp ile olur mu bilemedim. Beceremediğim bir konu.
Ancak aşağıdaki kodları bir Modüle içine yerleştirip sayfanızda çalıştırırsanız N-O-Q sütunlarında işlem yapmaktadır.
Çalıştırmadan önce dosyanın yedeğini almanızı tavsiye ederim.

C++:
Sub TekHaneleriDuzelt()
Dim Veri, ListeN, ListeO, ListeQ
Dim x As Byte, i As Long, k As Integer, xLen As Integer, Bak As String, Say As String, YeniDeger As String
    Veri = Range("N2:Q" & Range("N" & Rows.Count).End(3).Row).Value
    ReDim ListeN(1 To UBound(Veri), 1 To 1)
    ReDim ListeO(1 To UBound(Veri), 1 To 1)
    ReDim ListeQ(1 To UBound(Veri), 1 To 1)
   
    For x = 1 To 4
        If x = 3 Then x = 4
        For i = 1 To UBound(Veri)
            Bak = Veri(i, x)
            xLen = Len(Bak)
            YeniDeger = ""
            For k = 1 To xLen
                Say = Mid(Bak, k, 1)
                If IsNumeric(Mid(Bak, k, 1)) Then
                    If k = 1 And xLen = 1 Then
                        YeniDeger = YeniDeger & "0" & Say
                    ElseIf k = 1 And xLen > 1 And Not IsNumeric(Mid(Bak, 2, 1)) Then
                        YeniDeger = YeniDeger & "0" & Say
                    ElseIf k > 1 And xLen = 2 And Not IsNumeric(Left(Bak, 1)) Then
                        YeniDeger = YeniDeger & "0" & Say
                    ElseIf k > 1 And xLen > 2 And k < xLen And Not IsNumeric(Mid(Bak, k - 1, 1)) And Not IsNumeric(Mid(Bak, k + 1, 1)) Then
                        YeniDeger = YeniDeger & "0" & Say
                    ElseIf k = xLen And Not IsNumeric(Mid(Bak, k - 1, 1)) Then
                        YeniDeger = YeniDeger & "0" & Say
                    Else
                        YeniDeger = YeniDeger & Say
                    End If
                Else
                    YeniDeger = YeniDeger & Say
                End If

            Next k
            Select Case x
                Case 1
                ListeN(i, 1) = YeniDeger
                Case 2
                ListeO(i, 1) = YeniDeger
                Case Else
                ListeQ(i, 1) = YeniDeger
            End Select
        Next i
    Next x
    Range("N2").Resize(UBound(Veri), 1) = ListeN
    Range("O2").Resize(UBound(Veri), 1) = ListeO
    Range("Q2").Resize(UBound(Veri), 1) = ListeQ
    Erase Veri: Erase ListeN: Erase ListeO: Erase ListeQ
End Sub

ÖmerFaruk Bey,
Deneme yaptım bir sıkıntı görünmüyor, pazartesi detaylı kontrol edeceğim,
ilginiz ve desteğiniz için çok teşekkür ederim.
hayırlı geceler dilerim.
 
RegExp ile olur mu bilemedim. Beceremediğim bir konu.
Ancak aşağıdaki kodları bir Modüle içine yerleştirip sayfanızda çalıştırırsanız N-O-Q sütunlarında işlem yapmaktadır.
Çalıştırmadan önce dosyanın yedeğini almanızı tavsiye ederim.

C++:
Sub TekHaneleriDuzelt()
Dim Veri, ListeN, ListeO, ListeQ
Dim x As Byte, i As Long, k As Integer, xLen As Integer, Bak As String, Say As String, YeniDeger As String
    Veri = Range("N2:Q" & Range("N" & Rows.Count).End(3).Row).Value
    ReDim ListeN(1 To UBound(Veri), 1 To 1)
    ReDim ListeO(1 To UBound(Veri), 1 To 1)
    ReDim ListeQ(1 To UBound(Veri), 1 To 1)
   
    For x = 1 To 4
        If x = 3 Then x = 4
        For i = 1 To UBound(Veri)
            Bak = Veri(i, x)
            xLen = Len(Bak)
            YeniDeger = ""
            For k = 1 To xLen
                Say = Mid(Bak, k, 1)
                If IsNumeric(Mid(Bak, k, 1)) Then
                    If k = 1 And xLen = 1 Then
                        YeniDeger = YeniDeger & "0" & Say
                    ElseIf k = 1 And xLen > 1 And Not IsNumeric(Mid(Bak, 2, 1)) Then
                        YeniDeger = YeniDeger & "0" & Say
                    ElseIf k > 1 And xLen = 2 And Not IsNumeric(Left(Bak, 1)) Then
                        YeniDeger = YeniDeger & "0" & Say
                    ElseIf k > 1 And xLen > 2 And k < xLen And Not IsNumeric(Mid(Bak, k - 1, 1)) And Not IsNumeric(Mid(Bak, k + 1, 1)) Then
                        YeniDeger = YeniDeger & "0" & Say
                    ElseIf k = xLen And Not IsNumeric(Mid(Bak, k - 1, 1)) Then
                        YeniDeger = YeniDeger & "0" & Say
                    Else
                        YeniDeger = YeniDeger & Say
                    End If
                Else
                    YeniDeger = YeniDeger & Say
                End If

            Next k
            Select Case x
                Case 1
                ListeN(i, 1) = YeniDeger
                Case 2
                ListeO(i, 1) = YeniDeger
                Case Else
                ListeQ(i, 1) = YeniDeger
            End Select
        Next i
    Next x
    Range("N2").Resize(UBound(Veri), 1) = ListeN
    Range("O2").Resize(UBound(Veri), 1) = ListeO
    Range("Q2").Resize(UBound(Veri), 1) = ListeQ
    Erase Veri: Erase ListeN: Erase ListeO: Erase ListeQ
End Sub
Bu kodları yalnız B sütunundaki "Tarih" fotmatındaki değerlerin önüne sıfır koymak için nasıl kullanabilirm.
Örnek, 3.01.2022 olan tarihi 03.01.2022 gibi
 
B sütunundaki değerleriniz gerçekten tarihse hücre biçimlendirme ile yapabilirsiniz.

gg.aaaa.yyyy
 
Geri
Üst