yuzun23
Altın Üye
- Katılım
- 11 Mayıs 2006
- Mesajlar
- 657
- Excel Vers. ve Dili
- Ofis 2016 64 Bit Türkçe
- Altın Üyelik Bitiş Tarihi
- 17-01-2026
aşağıdaki makroda Sağolasın mahir bey en küçük değeri bulmada yardımcı olmuştu. şimdi ise en BÜYÜK değeri bulmada aşağı makro da nasıl bir değişiklik yapmak lazım şimdiden teşekkürler
'Koşullu Biçimlendirme renk indeksinin bulunması
Function KRenk(ByVal A As Range) As Double
Application.Volatile
KRenk = Evaluate("ri(" & A.Address() & ")")
End Function
-----------------------------------------
'Koşullu Biçimlendirme renk indeksinin bulunması
Private Function ri(ByVal A As Range) As Double
ri = A.DisplayFormat.Interior.Color
Calculate
End Function
-------------------------------------------
Sub SatinAlma()
Application.ScreenUpdating = False
Sheets("Tutanak").Unprotect
Range("B35:I40").ClearContents
For j = 5 To 10
mlz = "": fyt = 0: ad = 0
For i = 8 To 32
If KRenk(Cells(i, j)) = 5296274 Then
ad = ad + 1
'mlz = mlz & "," & Cells(i, 2).Text
mlzList = ad & " Kalem Malzeme " & mlz
fyt = fyt + Cells(i, 3).Value * Cells(i, j).Value
Cells(35 + j - 5, 2) = mlzList
Cells(35 + j - 5, 3) = Cells(6, j).Text
Cells(35 + j - 5, 9) = fyt
End If
Next
Next
Sheets("Tutanak").Protect
Application.ScreenUpdating = True
End Sub
'Koşullu Biçimlendirme renk indeksinin bulunması
Function KRenk(ByVal A As Range) As Double
Application.Volatile
KRenk = Evaluate("ri(" & A.Address() & ")")
End Function
-----------------------------------------
'Koşullu Biçimlendirme renk indeksinin bulunması
Private Function ri(ByVal A As Range) As Double
ri = A.DisplayFormat.Interior.Color
Calculate
End Function
-------------------------------------------
Sub SatinAlma()
Application.ScreenUpdating = False
Sheets("Tutanak").Unprotect
Range("B35:I40").ClearContents
For j = 5 To 10
mlz = "": fyt = 0: ad = 0
For i = 8 To 32
If KRenk(Cells(i, j)) = 5296274 Then
ad = ad + 1
'mlz = mlz & "," & Cells(i, 2).Text
mlzList = ad & " Kalem Malzeme " & mlz
fyt = fyt + Cells(i, 3).Value * Cells(i, j).Value
Cells(35 + j - 5, 2) = mlzList
Cells(35 + j - 5, 3) = Cells(6, j).Text
Cells(35 + j - 5, 9) = fyt
End If
Next
Next
Sheets("Tutanak").Protect
Application.ScreenUpdating = True
End Sub