• DİKKAT

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

Excel makro vba

Bunun için makroya gerek yok bildiğim kadarıyla.
Koşullu biçimlendirme ile yapabilirsin.

Tabi bu bence ve eğer sorunu doğru anladıysam :)
 
Koşullu biçimlendirmede yapamadım bide bitirme tezine eklenecek ondan vba da yazmak istedik.
 
Basit bir şey oldu ama deneyin bakalım arkadaşım olacak mı ?


Sub enbuyuk3sayi()
'
'
'
'
Cells.Select
Selection.FormatConditions.AddTop10
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.TopBottom = xlTop10Top
.Rank = 1
.Percent = False
End With
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("A1").Select
End Sub
Genişletmek için tıkla ...
 
Merhaba.
Aşağıdaki kod'u kullanabilirsiniz.
En büyük sayının adresi mesaj kutusu ile bildirilir ve zemin rengi kırmızı yapılır.
Kod: 
[FONT="Arial Narrow"][B]Sub MAK_BUL_BRN()[/B]
mak = -2.23E-308
For sat = 1 To 19
    For sut = 1 To 11
        If Cells(sat, sut) = "" Then GoTo 10
        sayı = WorksheetFunction.Substitute(Cells(sat, sut), ".", ",")
        If sayı > mak Then mak = sayı: sütun = sut: satır = sat
10: Next
Next
    Cells(satır, sütun).Interior.Color = [B][COLOR="red"]vbRed[/COLOR][/B]
    MsgBox "En Büyük Sayı :  " & mak & vbLf & _
        "Hücre Adresi   :  " & Cells(satır, sütun).Address(0, 0)
[COLOR="Red"]    Cells(satır, sütun).Activate[/COLOR]
[B]End Sub[/B][/FONT]
 
Son düzenleme:
Merhaba.
Yukarıda verdiğim kod'da End Sub satırından hemen önce aşağıdaki satırı ekleyin.
Yukarıdaki cevaptaki kod'u bunu da ekleyerek güncelledim.
Böylece en büyük sayının bulunduğu hücre seçilmiş olur.
.
Kod: 
    Cells(satır, sütun).Activate
Not: Yukarıda verdiğim kod'u (bu cevaptaki satırı da eklediğim halini)
alt taraftan sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde
açılan ekranın sağ tarafındaki boş alana yapıştırıp çalıştırmalısınız.
.
 
Son düzenleme:
Verdiğiniz bağlantı adresinde virüs uyarısı alıyorum.
dosya.tc'yi dener misiniz?

Ayrıca yukarıdaki son cevabıma bir kez daha bakar mısınız?
Belki istediğiniz sonucu alacaksınız.

İsteğiniz hala anlaşılmış değil.
.
 
sayısal değerlerin sayısı lazım bize en çok hangi alanı seçersek içindeki sayısal değerlerin sayısı en fazla olur. mesela A1 A3 hücresinin içindeki sayı değeri önemli değil sadece içinde sıfırdan büyük değer varsa onu 1 kabul edip en çok olanı seçicez
 
Arkadaşlar bu arkadaşım istediğini anlatamadı sanırım.
Bu arkadaş o fotoğrafta görülen alanların en geniş alanının renk değiştirmesini istiyor.
İyi ama benim anlamadığım şu;
en geniş olan zaten tamamı olmaz mı ?
Daraltma kriteri ne olacak ? yani hesaplama yaparken maksimum kaç hücre seçebilir? En köşe 4 hücreyi alsa zaten maksimum alanı elde edebilir.. Bu nedenle çok ucu açık gibi geldi bana. Daha detaylı bir açıklama yapılabilirse belki arkadaşlar yardımcı olabilirler.
 
Tekrar merhaba.
Aşağıdaki kod'u dener misiniz?
0 değeri aralara girdiğinde sorun var ama şimdilik çözüm olacaktır.
Kod: 
[FONT="Arial Narrow"]Sub BRN()
Cells.Interior.Pattern = xlNone
Cells.FormatConditions.Delete
adet = 0
adett = 0
For sat = 1 To 19 Step 2
    For süt = 1 To 11 Step 2
sayı = 0
        For satır = 1 To 19 Step 2
            For sütun = 1 To 11 Step 2
                If WorksheetFunction.CountIf(Range(Cells(sat, süt), _
                    Cells(satır, sütun)), "=0") > 0 Then GoTo 10
                    sayı = WorksheetFunction.CountIf(Range(Cells(sat, süt), _
                            Cells(satır, sütun)), ">0")
10
            If sayı > adet Then
                adet = sayı
            End If
            Next
        Next
                If adet > sonuç Then
                    sonuç = adet
                    ilk = Cells(sat, süt).Address(0, 0)
                End If
    Next
Next

For satt = 19 To 1 Step -2
    For sütt = 11 To 1 Step -2
sayıı = 0
        For satırr = 19 To 1 Step -2
            For sütunn = 11 To 1 Step -2
                If WorksheetFunction.CountIf(Range(Cells(satt, sütt), _
                    Cells(satırr, sütunn)), "=0") > 0 Then GoTo 20
                    sayıı = WorksheetFunction.CountIf(Range(Cells(satt, sütt), _
                            Cells(satırr, sütunn)), ">0")
20
            If sayıı > adett Then
                adett = sayıı
            End If
            Next
        Next
                If adett > sonuçç Then
                    sonuçç = adett
                    son = Cells(satt, sütt).Address(0, 0)
                End If
    Next
Next
Range(ilk & ":" & son).Interior.Color = vbRed
MsgBox "Başlangıç    " & ilk & vbLf & _
    "Bitiş           " & son & vbLf & _
    "Adet            " & sonuç
End Sub[/FONT]
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst