farklı olanın hücresini daha koyu %5 yapsın

[ozpoli]

arkadaşlar ekte yolladığım exel sayfasında ben formülle yaptım fakat bana makro ile formülle * konulmuş olanların hücreleri gri dolgu olacak fakat bu sırada yıldız işareti olmamış olcak

 

[Orion1]

dosyanızı 2003 formatında yollarsanız daha çabuk cevap alabilirsiniz.

 

[Ömer]

Merhaba,

Sorunuz net değil. Ayrıca dosyalarınızı 2003 formatında eklemeye özen göstermenizi rica ederim.

Çalışma sayfası kod bölümüne,

Private Sub Worksheet_Calculate()
Dim Alan As Range
    For Each Alan In Range("C3:T38")
    Alan.Interior.ColorIndex = xlNone
        If Left(Alan, 1) = "*" Then
            Alan.Interior.ColorIndex = 16
        End If
    Next Alan
End Sub

.

 

[ozpoli]

2003 olarak

2003 olarak dosya ektedir

 

[ozpoli]

2003 olarak ekledim ordaki formüller yerine aynı işlemi yaparak * yerine o hücreleri açık koyu yapacak bir makro gerekmektedir

 

[ozpoli]

arkadaşlar 2003 olarak dostyayı ekledım yardım edecek yok mu

 

[Ömer]

Merhaba,

Yazdığım kodları denediniz mi? Bu şekilde olmayacaksa olması gerekeni detaylı açıklayınız.

 

[ozpoli]

2003 olarak ekteki

2003 olarak ekte eklemiş olduğum örnekte formülle yaptığım işi makro yapacak bana o formül yerine aynı işi yapacak makro lazım

 

[Ömer]

Verdiğim kodlar formülün makrolu halidir. Eksik olan nedir? Sayfadaki çalılmaya göre değilde buton yardımıyla mı yapmak istiyorsunuz.

Butonla olacaksa,

Sub Renk()
Dim Alan As Range
    For Each Alan In Range("C3:T38")
    Alan.Interior.ColorIndex = xlNone
        If Left(Alan, 1) = "*" Then
            Alan.Interior.ColorIndex = 16
        End If
    Next Alan
End Sub

 

[ozpoli]

sadece koyu yapması değil orda hücrelerde bulunan formülüde makro nun yapması
"""bu arada ömer bey yardım ve ilginiz içinde teşşekür ederim"""

 

[ozpoli]

ömer bey merhaba

sanırım durumu özetleyebıldım acil olarak ihtiyacım olan bir konu yardımlarınızı beklıyorum teşşekür ederim

 

[Ömer]

Merhaba,

Ban göre formül ve koşullu biçimlendirme kullanmanız çok daha mantıklıdır.

Sadece formülü tek hücrede yazıp işlevsel bir biçimde düzenlemeniz gerekir.

B3 hücresine yazarak yana ve alt hücrelere kopyalayın. ( 2-3-4...19 şeklinde yazdığınız numara satırınıda kullanmanıza gerek yok.)

=EĞER($A3="YENİ";"*"&DÜŞEYARA($B3;'REV-B'!$A:$S;SÜTUN(B1);0);
EĞER($A3="İPTL";"İPTAL";EĞER(VE($A3="";DÜŞEYARA($B3;
'REV-A'!$A:$S;SÜTUN(B1);0)=DÜŞEYARA($B3;'REV-B'!$A:$S;SÜTUN(B1);0));DÜŞEYARA(
$B3;'REV-B'!$A:$S;SÜTUN(B1);0);"*"&DÜŞEYARA($B3;'REV-B'!$A:$S;SÜTUN(B1);0))))

Makro ile,

Sub Bul()
Dim i, j As Long
Dim Alan As Range
Set S1 = Sheets("REV-A")
Set S2 = Sheets("REV-B")
Application.ScreenUpdating = False
Sheets("SONUÇ").Select
Range("A3:A38").ClearContents
Range("C3:T38").ClearContents
    For i = 3 To 38
        For j = 3 To 20
            If WorksheetFunction.CountIf(S2.Range("A:A"), Cells(i, "b")) > WorksheetFunction.CountIf(S1.Range("A:A"), Cells(i, "b")) Then
                Cells(i, "a") = "YENİ"
            End If
            If WorksheetFunction.CountIf(S2.Range("A:A"), Cells(i, "b")) < WorksheetFunction.CountIf(S1.Range("A:A"), Cells(i, "b")) Then
                Cells(i, "a") = "İPTL"
            End If
            If WorksheetFunction.CountIf(S2.Range("A:A"), Cells(i, "b")) = WorksheetFunction.CountIf(S1.Range("A:A"), Cells(i, "b")) Then
                Cells(i, "a") = ""
            End If
            If Cells(i, "a") = "YENİ" Then
                Cells(i, j) = "*" & WorksheetFunction.VLookup(Cells(i, "b"), S2.Range("A:S"), j - 1, 0)
            End If
            If Cells(i, "a") = "İPTL" Then
                Cells(i, j) = "İPTAL"
            End If
            If WorksheetFunction.CountIf(S1.Range("A:A"), Cells(i, "b")) <> 0 And WorksheetFunction.CountIf(S2.Range("A:A"), Cells(i, "b")) <> 0 Then
                If Cells(i, "a") = "" And WorksheetFunction.VLookup(Cells(i, "b"), S1.Range("A:S"), j - 1, 0) = WorksheetFunction.VLookup(Cells(i, "b"), S2.Range("A:S"), j - 1, 0) Then
                    Cells(i, j) = WorksheetFunction.VLookup(Cells(i, "b"), S2.Range("A:S"), j - 1, 0)
                Else
                    Cells(i, j) = "*" & WorksheetFunction.VLookup(Cells(i, "b"), S2.Range("A:S"), j - 1, 0)
                End If
            End If
        Next j
    Next i
    For Each Alan In Range("C3:T38")
    Alan.Interior.ColorIndex = xlNone
        If Left(Alan, 1) = "*" Then
            Alan.Interior.ColorIndex = 16
        End If
    Next Alan
Application.ScreenUpdating = True
End Sub

.

 

[ozpoli]

ellerine sağlık teşşekür ederim