makro'da simgeler

[Öz1.618]

Merhaba,
Çalışma sayfamın tamamında hücreler içerisinde 'Tamamlandı' yazan kelimeyi tik işaretiyle değiştirmek istiyorum. Bunu makro kısmında nasıl yapabilirim?
Konu hakkında yardımlarınızı rica ederim.

 

[Ömer]

Merhaba,

Makroya gerek kalmadan da yapabilirsiniz.

Ctrh + H (bul değiştir)

Aranan değer bölümüne: Tamamlandı
Yeni değer bölümüne: ✔

Yazıp tümünü değiştire basın.

 

[Öz1.618]

Evet oradan şu şekilde yapılıyor.

(Ctrh + H) tan replace with kısmına 'ü' yazıyorsun. Sonra options - font Wingdings' i seçiyorsun yapılıyor. Ama makrolarıma kaydedip otomatik yapmak istedim. aslında aşağıdaki kodu buldum ama geliştirmek için çabalıyorum. mesela aşağıdaki kodda "SIN"'leri "COS" yapıyor.

Worksheets("Sheet1").Columns("A").Replace _ What:="SIN", Replacement:="COS", SearchOrder:=xlByColumns, MatchCase:=True

aşağıdaki kodda da hücre içerisine sembol atama kodu var. ikisini birleştirmeye çalışıyorum şimdi.

sub sembol ()
range("a1") = ChrW("&h0020")
range("a1").font.name = "wingdings"
End Sub.

Özetle çalışma sayfamda hücre içerisinde 'Tamamlandı' yazanları seçip sonra onları tik sembolü ile değiştirip font kısmını da "wingdings" (ange("a1").font.name = "wingdings") yapmalıyım.

 

[Haluk]

Aşağıdaki kod sayfada A1:A500 aralığında istediğiniz işi yapar...

Sub Test()
    'Haluk - 24/10/2019
    'sa4truss@gmail.com
    '
    Dim myCell As Range
    With Range("A1:A500")
        Set myCell = .Find("Tamamlandı", LookIn:=xlValues)
        If Not myCell Is Nothing Then
            Do
                myCell.Value = "ü"
                myCell.Font.Name = "Wingdings"
                Set myCell = .FindNext(myCell)
            Loop While Not myCell Is Nothing
        End If
    End With
    Set myCell = Nothing
End Sub

.

 

[Öz1.618]

Aşağıdaki kod sayfada A1:A500 aralığında istediğiniz işi yapar...

Sub Test()
    'Haluk - 24/10/2019
    'sa4truss@gmail.com
    '
    Dim myCell As Range
    With Range("A1:A500")
        Set myCell = .Find("Tamamlandı", LookIn:=xlValues)
        If Not myCell Is Nothing Then
            Do
                myCell.Value = "ü"
                myCell.Font.Name = "Wingdings"
                Set myCell = .FindNext(myCell)
            Loop While Not myCell Is Nothing
        End If
    End With
    Set myCell = Nothing
End Sub

.

denedim ama olmadı

 

[Öz1.618]

Aşağıdaki kod sayfada A1:A500 aralığında istediğiniz işi yapar...

Sub Test()
    'Haluk - 24/10/2019
    'sa4truss@gmail.com
    '
    Dim myCell As Range
    With Range("A1:A500")
        Set myCell = .Find("Tamamlandı", LookIn:=xlValues)
        If Not myCell Is Nothing Then
            Do
                myCell.Value = "ü"
                myCell.Font.Name = "Wingdings"
                Set myCell = .FindNext(myCell)
            Loop While Not myCell Is Nothing
        End If
    End With
    Set myCell = Nothing
End Sub

.

Tamam çalıştı. Çok teşekkür ederim Haluk bey. Sütun aralığını genişletmemişim.