İçinde Eğer ve Metin formülleri bulunan bir makro yazmak

[manyakbiri]

Merhabalar,

Yazmak istediğim bir makro var.

A sütununda, 1. satırdan 3500. satıra kadar tüm satırları sırası ile kontrol edecek,

EĞER, SOLDAN ilk 6 hane "Toplam" kelimesine veya "Genel " kelimesine eşitse, üzerinde bulunduğu satırı A sütunundan N sütununa kadar altı çift çizgili ve üstü tek çizgili yapsın aynı zamanda da satırdaki metinleri kalınlaştırsın istiyorum.

Gene aynı şekilde A sütununu kontrol ederek, hücrenin içerisinde "(boş)" metni içeren tüm satırları kaldırsın istiyorum.

Sizin yazdıklarınıza bakarak bu makro nasıl yazılır öğrenme niyetindeyim. Arzu ettiğim şekilde makroyu yazabilirsek hem bana yardımcı olur hem de bu tip makrolar nasıl yazılır öğretmiş olursunuz.

Teşekkürler.

 

[YUSUF44]

Aşağıdaki kodları inceleyiniz:

Sub geneltoplam()
son = Cells(Rows.Count, "A").End(3).Row
For i = son To 1 Step -1
    If Cells(i, "A") = "" Then
        Rows(i).Delete
    ElseIf WorksheetFunction.Proper(Left(Cells(i, "A"), 5)) = "Genel" Or _
            WorksheetFunction.Proper(Left(Cells(i, "A"), 6)) = "Toplam" Then
        With Range("A" & i & ":N" & i).Font
            .Name = "Calibri"
            .FontStyle = "Normal"
            .Size = 11
            .Strikethrough = True
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleDouble
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .ThemeFont = xlThemeFontMinor
            .Bold = True
        End With
    End If
Next

End Sub

 

[manyakbiri]

Öncelikle çok teşekkür ederim,

Fakat boş satırların silinmesini istemiyorum, belgemde boş satır yok, pivot çektiğim için (boş) ile başlayan satırlar var ve başka bir satırda da Toplam (boş) diye bir satır var, ben bunların silinmesini istiyorum. İçinde "(boş)" geçen satır diyerek bunu kastettim.

Saygılar,

 

[manyakbiri]

Bir de altı çift çizgili ve üstü tek çizgi şu şekilde gözüktü.

Arada veri olmayan hücrelere de bu biçimin uygulanmasını istiyorum, görselde de görüleceği üzere asıl sorun altı çift çizgi üstü tek çizgi şeklinde makronun çalışmaması.

 

[YUSUF44]

Aşağıdaki gibi deneyiniz:

Sub geneltoplam()
son = Cells(Rows.Count, "A").End(3).Row
For i = son To 1 Step -1
    If Len(WorksheetFunction.Substitute(WorksheetFunction.Proper(Cells(i, "A")), "(Boş)", "")) <> Len(Cells(i, "A")) Then
        Rows(i).Delete
    ElseIf WorksheetFunction.Proper(Left(Cells(i, "A"), 5)) = "Genel" Or _
            WorksheetFunction.Proper(Left(Cells(i, "A"), 6)) = "Toplam" Then
        With Range("A" & i & ":N" & i).Font
            .Name = "Calibri"
            .FontStyle = "Normal"
            .Size = 11
            .Strikethrough = True
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleDouble
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .ThemeFont = xlThemeFontMinor
            .Bold = True
        End With
    End If
Next

End Sub

 

[manyakbiri]

(boş) 'ların silinmesi meselesini çözdük fakat bir üstteki upload ettiğim resimde göreceğiniz üzere format çok kötü duruyor. Alt çift çizgi ve üste tek çizgi istiyorum ve bunu tüm satır boyuncu uygulayacak hücre hücre değil, hücre aralarında çizgi boşlukları olmayacak.

 

[YUSUF44]

Alt çizgi ve üst çizgi derken ben yazının alt ve üstünün çizileceğini düşünmüştüm. Sanıyorum siz hücre kenarlığı şeklinde istiyorsunuz. Şöyle deneyin:

Sub geneltoplam()
son = Cells(Rows.Count, "A").End(3).Row
For i = son To 1 Step -1
    If Len(WorksheetFunction.Substitute(WorksheetFunction.Proper(Cells(i, "A")), "(Boş)", "")) <> Len(Cells(i, "A")) Then
        Rows(i).Delete
    ElseIf WorksheetFunction.Proper(Left(Cells(i, "A"), 5)) = "Genel" Or _
            WorksheetFunction.Proper(Left(Cells(i, "A"), 6)) = "Toplam" Then
        Range("A" & i & ":N" & i).Font.Bold = True
        With Range("A" & i & ":N" & i).Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("A" & i & ":N" & i).Borders(xlEdgeBottom)
            .LineStyle = xlDouble
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThick
        End With
        
    End If
Next

End Sub

 

[manyakbiri]

Alt çizgi ve üst çizgi derken ben yazının alt ve üstünün çizileceğini düşünmüştüm. Sanıyorum siz hücre kenarlığı şeklinde istiyorsunuz. Şöyle deneyin:

Sub geneltoplam()
son = Cells(Rows.Count, "A").End(3).Row
For i = son To 1 Step -1
    If Len(WorksheetFunction.Substitute(WorksheetFunction.Proper(Cells(i, "A")), "(Boş)", "")) <> Len(Cells(i, "A")) Then
        Rows(i).Delete
    ElseIf WorksheetFunction.Proper(Left(Cells(i, "A"), 5)) = "Genel" Or _
            WorksheetFunction.Proper(Left(Cells(i, "A"), 6)) = "Toplam" Then
        Range("A" & i & ":N" & i).Font.Bold = True
        With Range("A" & i & ":N" & i).Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Range("A" & i & ":N" & i).Borders(xlEdgeBottom)
            .LineStyle = xlDouble
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThick
        End With
        
    End If
Next

End Sub

Tek kelime ile müthiş! Elinize sağlık çok teşekkür ediyorum.