Soru Tc ve Cep kısmını yıldızlama makro ile?

balanar

Altın Üye
Katılım
22 Şubat 2021
Mesajlar
347
Excel Vers. ve Dili
Excel 2007
Altın Üyelik Bitiş Tarihi
09-03-2027
Merhaba, örnek bir dosya ekledim. Birkaç sayfasını tabi sayfalar 3ten fazla normalde..

Tek makro kodu ile F ve G sutunundaki tc ve cep telefonlarının 5-6-7-8-9 karakterlerini nasıl yıldızlayabiliriz?

Buradaki sıkıntı satır sayıları farklı onu nasıl ayırt edecek?
 

Ekli dosyalar

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

Yıldızlamadan kastınız. 11111111111 değerini 1111****111 yazmak mı?
Eğer öyleyse eski veri yerine bu şekilde düzenleme olacak sanırım. Peki gerçek verilerinize ulaşmak isterseniz sizin için sorun olmayacak mı?
 

balanar

Altın Üye
Katılım
22 Şubat 2021
Mesajlar
347
Excel Vers. ve Dili
Excel 2007
Altın Üyelik Bitiş Tarihi
09-03-2027
Merhaba,

Yıldızlamadan kastınız. 11111111111 değerini 1111****111 yazmak mı?
Eğer öyleyse eski veri yerine bu şekilde düzenleme olacak sanırım. Peki gerçek verilerinize ulaşmak isterseniz sizin için sorun olmayacak mı?
Yedek barındıracağız hocam. Evet doğru anladığınız gibi
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Deneyiniz.
Kod:
Sub test()
   
    Dim syf As Worksheet, i As Long, Wf As WorksheetFunction
   
    Set Wf = WorksheetFunction
   
    For Each syf In ThisWorkbook.Worksheets
        Select Case syf.Name
            Case "27.12.2021 Y-1", "28.12.2021 Y-2", "29.12.2021 Y-3" 'değişim yapılacak sayfalar

            For i = 3 To syf.[F:G].Find("*", , , , xlByRows, xlPrevious).Row
                syf.Cells(i, "F") = Wf.Replace(syf.Cells(i, "F"), 5, 5, Wf.Rept("*", 5))
                syf.Cells(i, "G") = Wf.Replace(syf.Cells(i, "G"), 5, 5, Wf.Rept("*", 5))
            Next i
           
        End Select
    Next syf
   
End Sub
 

balanar

Altın Üye
Katılım
22 Şubat 2021
Mesajlar
347
Excel Vers. ve Dili
Excel 2007
Altın Üyelik Bitiş Tarihi
09-03-2027
teşekkürler ömer hocam
 

mars2

Altın Üye
Katılım
2 Eylül 2004
Mesajlar
564
Excel Vers. ve Dili
2016 - Türkçe
2019 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2026
İyi akşamlar;
Sayın Ömer bey yukarıda verdiğiniz kodu Sayfa1'deki B10 hücresinde bulanan TC Nosuna göre revize etmek mümkün müdür.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,306
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
Option Explicit

Sub Test()
    Dim WF As WorksheetFunction
    Set WF = WorksheetFunction
    [Sayfa1!B10] = WF.Replace([Sayfa1!B10], 5, 5, WF.Rept("*", 5))
    Set WF = Nothing
End Sub
 

mars2

Altın Üye
Katılım
2 Eylül 2004
Mesajlar
564
Excel Vers. ve Dili
2016 - Türkçe
2019 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2026
Sayın Korhan Ayhan;

cevabınız için teşekkürler.
 
Üst