DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub biçim()
Sat = [a65536].End(3).Row
Min = Application.WorksheetFunction.Min(Range(Cells(1, "a"), Cells(Sat, "a")))
For x = 1 To Sat
Cells(x, "a").Interior.ColorIndex = xlNone
If Cells(x, "a") = Min Then Cells(x, "a").Interior.ColorIndex = 4
Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Sat = [a65536].End(3).Row
If Intersect(Target, Range(Cells(1, "a"), Cells(Sat, "a"))) Is Nothing Then Exit Sub
Min = Application.WorksheetFunction.Min(Range(Cells(1, "a"), Cells(Sat, "a")))
For Each x In Range(Cells(1, "a"), Cells(Sat, "a"))
x.Interior.ColorIndex = xlNone
If x = Min Then x.Interior.ColorIndex = 4
Next
End Sub
Öncekinde benim 2 satır fazlam vardı. :hihoho:Etme bulma dünyası, bu sefer de ben 1 dk gecikmişim. Yalnız benim bir satır fazlam var.:biggrin:
Private Sub Worksheet_Change(ByVal Target As Range)
Sat = [s65536].End(3).Row
If Intersect(Target, Range(Cells(2, "s"), Cells(Sat, "s"))) Is Nothing Then Exit Sub
Min = Application.WorksheetFunction.Min(Range(Cells(2, "s"), Cells(Sat, "s")))
For Each x In Range(Cells(2, "s"), Cells(Sat, "s"))
[COLOR="Red"]If x.Interior.ColorIndex <> 3 Then[/COLOR] x.Interior.ColorIndex = xlNone
If x = Min And x.Interior.ColorIndex <> 3 Then x.Interior.ColorIndex = 4
Next
End Sub
Hocam ilk kriter bitti daha onun için yakıt tipinden 1. seçeneği (işleminizi yaptıkça) seçerek ekleyeceklerinizin çalışıp çalışmadığını anlayabilirsiniz çok sağolunSon haliyle dosyayı ekleyebilir misiniz? Onun üzerinde deneyeyim.
Anladım siz, hücre minimum değilse kırmızı kalmasını istiyorsunuz. Aksi takdirde kırmızı da olsa yeşil olsun.bu kod şunu yapıyor minimumu bulduruyor ama o minimum ya kırmızılar arasında ise yeşil renk işe yaramıyor hücre kırmızı kalıyor
Private Sub Worksheet_Change(ByVal Target As Range)
Sat = [a65536].End(3).Row
If Intersect(Target, Range(Cells(1, "a"), Cells(Sat, "a"))) Is Nothing Then Exit Sub
Min = Application.WorksheetFunction.Min(Range(Cells(1, "a"), Cells(Sat, "a")))
For Each x In Range(Cells(1, "a"), Cells(Sat, "a"))
If x = Min Then x.Interior.ColorIndex = xlNone
If x.Interior.ColorIndex <> 3 Then x.Interior.ColorIndex = xlNone
If x = Min And x.Interior.ColorIndex <> 3 Then x.Interior.ColorIndex = 4
Next
End Sub