VBA İçinde harf olan şekillerin sayısını bulmak

[erky63]

Herkese merhabalar,

Forumda yeniyim, ama arama yaptığım halde bulamadım.

Sorum şu olacak ki, exceldeki sayfada 200 kadar içi ve çerçevesi yeşil renge boyalı yuvarlak köşeli dikdörtgen şekiller mevcut. Bunların bazılarının içine H (hurda) , Ç (çatlak) , K (kırık) , ? (şüpheli) anlamına gelen büyük harfler bulunuyor. Belli bir range içindeki bu şekillerden içinde bu harflerden her hangi birini bulunduran şekillerin sayını veren bir makro oluşturmaya çalışıyorum.

Belirlenen bir range içindeki içi yeşil (ya da artık hangi renkse) olan şekillerin sayısını veren makroyu yaptım ama içinde harf olanların sayısını veren makroyu yapamadım. yardımcı olabilecek var mı acaba?

Şimdiden teşekkür ediyorum.

 

[askm]

Örnek tablonuzu eklerseniz msgbox veya farklı bir sayfaya sayıları alacak şekilde işlem yapabiliriz. Formülle isterseniz eğersay formulu kullanabilirsiniz.

 

[erky63]

Yalnız eğersay (ya da countif) formulü belirlenen bir alanda belirlenen bir veriyi bulmak için değil miydi?
Çünkü o şekilde denemiştim lakin olmamıştı. Benim bahsettiğim dikdörtgen şekiller var, onların içine harf koyuyorum ve içinde harf olan dikdörtgen şekillerin sayısını bulmanın yolunu sormuştum.

 

[askm]

Örnek dosya paylaşın inanın çözüm bulmak zor olmayacaktır. Sadece soru olunca pek anlaşılmıyor ve bakılmıyorda. Hem örnek eklendiği zaman kullanmak isteyen arkadaşlar için de kaynak olmuş oluyor. Örnek eklerseniz sabah bakarım inşallah.

 

[erky63]

Tamamdır hallettim.
Belirlenen bir alandaki yeşil (ya da hangi renkse) kutuları şu şekilde saydırabiliyorum:

Function CountRectGreen(rg As Range) As Long
'Returns a count of green rectangles in a range
Dim shp As Shape
Dim i As Long
Application.Volatile
With rg.Worksheet
For Each shp In .Shapes
If shp.AutoShapeType = msoShapeRoundedRectangle Then
If shp.Fill.ForeColor.RGB = RGB(155, 187, 89) Then
If Not Intersect(rg, shp.TopLeftCell) Is Nothing Then i = i + 1
End If
End If
Next
End With
CountRectGreen = i
End Function

işte bu makroya, belirlenen alandaki o renkli kutuların içinde "H" olanları saymayı yaptıramıyordum ki onu da şu şekilde hallettim:

Function CountRectHurda(rg As Range) As Long
'Returns a count of Hurda rectangles in a range
Dim shp As Shape
Dim i As Long
Dim text As String
Application.Volatile
With rg.Worksheet
For Each shp In .Shapes
If shp.AutoShapeType = msoShapeRoundedRectangle Then
If shp.TextFrame.Characters.text = "H" Then
If Not Intersect(rg, shp.TopLeftCell) Is Nothing Then i = i + 1
End If
End If
Next
End With
CountRectHurda = i
End Function

Yine de teşekkürler ilginiz için. Demek ki biraz daha uğraşmak gerekiyormuş.

 

[systran]

sizin kullanmış olduğunuz kodda belirli bir aralıktaki şekillere bakar. aşağıdaki kod ise aktif sayfadaki tüm şekilleri kontrol eder, şekil yuvarlatılmış dikdörtgen ise (rounded rectangle) içindeki yazıyı gösterir.
aşağıdaki kodu deneyip kendiniz geliştirmeye çalışın.

Sub sekil()
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        If sh.AutoShapeType = msoShapeRoundedRectangle Then
             MsgBox sh.TextFrame.Characters.Text
        End If
    Next
End Sub