Soru Orana göre otomatik uyarı

[darmaduman]

Merhabalar, ekteki dosyada göreceğiniz üzere iki sayfa var. müşteriden her ay gelen yüzlerce satırlık satış arasında oranları otomatik hesaplamaya çalışmaya çalışıyorum ama benim belirlediğim (ana veriler sayfasında) yüzdenin üzerindeyse uyarı vermesini sağlayamadım bir türlü. ve sonradan bir kaç sütun ekledim (dosyada yeşil olarak işaretli) bunları vba'da nasıl işleme almam gerektiğini çözemedim bir türlü.

DOSYA.CO

Sub Test()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("ANA VERİLER")
ss1 = s1.Cells(Rows.Count, "A").End(3).Row
ss2 = s2.Cells(Rows.Count, "A").End(3).Row
    For i = 3 To ss1
        s1.Cells(i, 5) = s1.Cells(i, 4).Value / s1.Cells(i, 3).Value
        Aranan = Cells(i, 1)
        With s2.Range("A1:A" & ss2)
            Set c = .Find(Aranan, LookIn:=xlValues)
            If Not c Is Nothing Then
                If .Cells(c.Row, 3) = Abs(s1.Cells(i, 5) * 100) Then
                    s1.Cells(i, 6) = "TAM SINIRDA OK."
                Else
                    s1.Cells(i, 6) = "EN FAZLA " & s2.Cells(c.Row, 3) & " OLMASI GEREKİYOR"
                End If
            End If
         End With
    Next i
    Range("E3:E" & ss1).NumberFormat = "0.00%"
    Range("E3:E" & ss1).Interior.Color = vbYellow
End Sub

 

[dEdE]

Bu mudur?

Sub Test()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("ANA VERİLER")
ss1 = s1.Cells(Rows.Count, "A").End(3).Row
ss2 = s2.Cells(Rows.Count, "A").End(3).Row
    For i = 3 To ss1
        s1.Cells(i, 8) = s1.Cells(i, 7).Value / s1.Cells(i, 6).Value
        Aranan = Cells(i, 4)
        With s2.Range("A1:A" & ss2)
            Set c = .Find(Aranan, LookIn:=xlValues)
            If Not c Is Nothing Then
                If .Cells(c.Row, 3) = Abs(s1.Cells(i, 8) * 100) Then
                    s1.Cells(i, 9) = "TAM SINIRDA OK."
                Else
                    s1.Cells(i, 9) = "EN FAZLA " & s2.Cells(c.Row, 3) & " OLMASI GEREKİYOR"
                End If
            End If
         End With
    Next i
    Range("H3:H" & ss1).NumberFormat = "0.00%"
    Range("H3:H" & ss1).Interior.Color = vbYellow
End Sub

 

[darmaduman]

Bu mudur?

Sub Test()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("ANA VERİLER")
ss1 = s1.Cells(Rows.Count, "A").End(3).Row
ss2 = s2.Cells(Rows.Count, "A").End(3).Row
    For i = 3 To ss1
        s1.Cells(i, 8) = s1.Cells(i, 7).Value / s1.Cells(i, 6).Value
        Aranan = Cells(i, 4)
        With s2.Range("A1:A" & ss2)
            Set c = .Find(Aranan, LookIn:=xlValues)
            If Not c Is Nothing Then
                If .Cells(c.Row, 3) = Abs(s1.Cells(i, 8) * 100) Then
                    s1.Cells(i, 9) = "TAM SINIRDA OK."
                Else
                    s1.Cells(i, 9) = "EN FAZLA " & s2.Cells(c.Row, 3) & " OLMASI GEREKİYOR"
                End If
            End If
         End With
    Next i
    Range("H3:H" & ss1).NumberFormat = "0.00%"
    Range("H3:H" & ss1).Interior.Color = vbYellow
End Sub

hocam kesinlikle doğru anlamışsınız, fazla sütun koyduğumda artık sorun olmuyor. geriye kalan tek sorun: "en fazla xxx olması gerekiyor" diye bir uyarım var. mesela hesaplamada yüzde 40 çıktı ama ana veriye göre en fazla yüzde 30 olması gerekiyor diyelim. fazla çıktığında uyarı verme işlemini nasıl yapabilirim. alert versin, uyarı versin ya da kırmızı falan yapabilir miyim. böylece direkt olması gerekenin üstündekileri tespit etmiş olabileceğim.

 

[dEdE]

Bunu deneyelim.

Sub Test()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("ANA VERİLER")
ss1 = s1.Cells(Rows.Count, "A").End(3).Row
ss2 = s2.Cells(Rows.Count, "A").End(3).Row
Range("I3:I" & ss1).Clear
Range("I3:I" & ss1).Font.Bold = True
Range("I3:I" & ss1).Font.Color = vbWhite

    For i = 3 To ss1
        s1.Cells(i, 8) = s1.Cells(i, 7).Value / s1.Cells(i, 6).Value
        Aranan = s1.Cells(i, 4)
        With s2.Range("A1:A" & ss2)
            Set c = .Find(Aranan, LookIn:=xlValues)
            If Not c Is Nothing Then
                If .Cells(c.Row, 3) = Abs(s1.Cells(i, 8) * 100) Then
                    s1.Cells(i, 9) = "EŞİT"
                    s1.Cells(i, 9).Interior.Color = vbGreen
                End If
                If .Cells(c.Row, 3) > Abs(s1.Cells(i, 8) * 100) Then
                    s1.Cells(i, 9) = "AZ"
                    s1.Cells(i, 9).Interior.Color = vbBlue
                End If
                If .Cells(c.Row, 3) < Abs(s1.Cells(i, 8) * 100) Then
                    s1.Cells(i, 9) = "FAZLA"
                    s1.Cells(i, 9).Interior.Color = vbRed
                End If
            End If
         End With
    Next i
    Range("H3:H" & ss1).NumberFormat = "0.00%"
    Range("H3:H" & ss1).Interior.Color = vbYellow
End Sub

 

[darmaduman]

Bunu deneyelim.

Sub Test()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("ANA VERİLER")
ss1 = s1.Cells(Rows.Count, "A").End(3).Row
ss2 = s2.Cells(Rows.Count, "A").End(3).Row
Range("I3:I" & ss1).Clear
Range("I3:I" & ss1).Font.Bold = True
Range("I3:I" & ss1).Font.Color = vbWhite

    For i = 3 To ss1
        s1.Cells(i, 8) = s1.Cells(i, 7).Value / s1.Cells(i, 6).Value
        Aranan = s1.Cells(i, 4)
        With s2.Range("A1:A" & ss2)
            Set c = .Find(Aranan, LookIn:=xlValues)
            If Not c Is Nothing Then
                If .Cells(c.Row, 3) = Abs(s1.Cells(i, 8) * 100) Then
                    s1.Cells(i, 9) = "EŞİT"
                    s1.Cells(i, 9).Interior.Color = vbGreen
                End If
                If .Cells(c.Row, 3) > Abs(s1.Cells(i, 8) * 100) Then
                    s1.Cells(i, 9) = "AZ"
                    s1.Cells(i, 9).Interior.Color = vbBlue
                End If
                If .Cells(c.Row, 3) < Abs(s1.Cells(i, 8) * 100) Then
                    s1.Cells(i, 9) = "FAZLA"
                    s1.Cells(i, 9).Interior.Color = vbRed
                End If
            End If
         End With
    Next i
    Range("H3:H" & ss1).NumberFormat = "0.00%"
    Range("H3:H" & ss1).Interior.Color = vbYellow
End Sub

emeğinizin karşılığını ödeyemem, çok teşekkür ederim. tam işimi görür vaziyette şu an.