maximum değeri gecemez

ufukufuk01 · 13 Şubat 2021

Merhabalar

Ekteki örnek tabloda olduğu için bir tablom var bu tabloya her satır için çalışacak bir döngü yaratmak istiyorum.

şimdiden yardımlarınız için tşk.ler...

İndir max gecemez

Dosyayı indir max gecemez

dosya.co

Korhan Ayhan · 14 Şubat 2021

%10'dan kastınız nedir?

ufukufuk01 · 14 Şubat 2021

Korhan Ayhan' Alıntı:
%10'dan kastınız nedir?

Merhabalar

B4 hücresine sayı girildiği zaman C4,D4,E4 son satıra kadar girilen sayının %10u kadar örnek B4 300 ise c4 270 d4(c4 %10dan düşük) D4 243 E4 218 gibi 2. sutunda verilen adetleri topluyor. eğer bu rakam max adetten büyük ise geri kalan örnek 6. satırda max rakama ulaştı ise 6.satırdan sonrası 0 olacak. Yukarıdaki değerler bozulmadan sonraki B sutununa B10, B20 gibi girilen sayılar ne olursa olsun 0 gelecek. Eğer B sutunundaki hücrelerdeki sayılardan örnek B5 satırındaki sayı silinir ise diğer C5,D5,E5 son satıra kadar tüm satırdaki rakamlar silinecek.

inşallah anlatabilmişimdir.

ufukufuk01 · 14 Şubat 2021

Bu arada Her sutunun kendi max sayısı var her sütun kendi max sayısına ulaştığı zaman 0 verecek. Örnek D4 sutunu max sayısına ulaşır ise D4 E 0 verecek d4 verisinie verilecek olan normal veri sayısı E4 satırına verilecek.

Örnek B4. 300 (sayısı) , C4 270(sayısı) ,D4(max sayıya ulaştı) 0, E4 (243) gibi

teşekkür ederim.

Korhan Ayhan · 14 Şubat 2021

Çok anlayamadım ama sakin kafayla bir daha değerlendirmeye çalışırım.

ufukufuk01 · 15 Şubat 2021

Korhan Ayhan' Alıntı:
Çok anlayamadım ama sakin kafayla bir daha değerlendirmeye çalışırım.

Hocam satır bazında sadece b sutunu manuel sayı yazılacak diğer c,d,e,f, son sutuna kadar b sutunundaki (b4örnek) manuel rakam yazıldı diğer stundaki 4. satıra girilen rakam tam sayı olarak %10 düşük halini yazacak. Bu rakam yukarı yuvarlanabilir. Diğer bir koşulda manuel girilen rakam 1. satırdaki max. sayıyı geçer ise 0(sıfır olarak gelecek) ben 2. satırı kendimce topla yaptım makroya göre kalan adette oraya yazılabilir. 2. Satır için kendimce bir bilgi amaçlı. Diğer bir noktada ise satıra (b4 satırına örnek) manuel girilen rakam silinir ise diğer aynı satırdaki sutundaki (,D4,E4,F4 sona kadar) rakamlarda silinecek. Anlatabilmişimdir. Umarım....

Şimdiden Teşekkür ederim.

Korhan Ayhan · 18 Şubat 2021

Paylaştığınız dosyaya göre;

Diyelim ki;

B4 hücresine 300 yazdınız. Diğer satırlar boş olsun.

Bu durumda C4:H4 arasında görmek istediğiniz sonuç nedir?

Başka bir örnek;

B4 hücresine 500 yazdınız. Diğer satırlar boş olsun.

Bu durumda C4:H4 arasında görmek istediğiniz sonuç nedir?

Durumu kavrarsak kodu tasarlayabiliriz.

Korhan Ayhan · 18 Şubat 2021

Kodları sayfanın kod bölümüne uygulayıp deneyiniz.

Çoklu veri girişinde çalışmaz.

Deneyin. Olmayan yeri varsa revize ederiz.

C++:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim X As Integer, Y As Integer, Son As String, Adet As Double
    
    On Error GoTo 10
    
    Son = Cells(Rows.Count, Cells(1, Columns.Count).End(1).Column).Address(0, 0)

    If Intersect(Target, Range("B4:" & Son)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.EnableEvents = False
    
    If IsNumeric(Target) And Not IsEmpty(Target) Then
        Target.Offset(, 1).Resize(1, Columns.Count - Target.Column).ClearContents
        If Target.Value > Cells(1, Target.Column) Then
            MsgBox "Maksimum adetten büyük değer girmeyiniz!", vbCritical
            Target.ClearContents
            GoTo 10
        End If
                
        If WorksheetFunction.Sum(Range(Cells(4, Target.Column), Cells(Rows.Count, Target.Column))) > Cells(1, Target.Column) Then
            MsgBox "Sütun toplamı maksimum adetten büyük olamaz!" & vbCr & vbCr & "Değer silinecektir.", vbCritical
            Target.ClearContents
            GoTo 10
        End If
        
        Adet = Target.Value
        
        For X = Target.Offset(, 1).Column To Cells(1, Columns.Count).End(1).Column
            Adet = Int(Adet * 0.9)
            For Y = X To Cells(1, Columns.Count).End(1).Column
                If (WorksheetFunction.Sum(Range(Cells(4, Y), Cells(Rows.Count, Y))) + Adet) > Cells(1, Y) Then
                    Cells(Target.Row, Y) = 0
                Else
                    Cells(Target.Row, Y) = Adet
                    Exit For
                End If
            Next
            Adet = Cells(Target.Row, Y)
        Next
    End If

10  Application.EnableEvents = True
End Sub

ufukufuk01 · 19 Şubat 2021

Korhan Ayhan' Alıntı:
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim X As Integer, Y As Integer, Son As String, Adet As Double On Error GoTo 10 Son = Cells(Rows.Count, Cells(1, Columns.Count).End(1).Column).Address(0, 0) If Intersect(Target, Range("B4:" & Son)) Is Nothing Then Exit Sub If Target.Cells.Count > 1 Then Exit Sub Application.EnableEvents = False If IsNumeric(Target) And Not IsEmpty(Target) Then Target.Offset(, 1).Resize(1, Columns.Count - Target.Column).ClearContents If Target.Value > Cells(1, Target.Column) Then MsgBox "Maksimum adetten büyük değer girmeyiniz!", vbCritical Target.ClearContents GoTo 10 End If If WorksheetFunction.Sum(Range(Cells(4, Target.Column), Cells(Rows.Count, Target.Column))) > Cells(1, Target.Column) Then MsgBox "Sütun toplamı maksimum adetten büyük olamaz!" & vbCr & vbCr & "Değer silinecektir.", vbCritical Target.ClearContents GoTo 10 End If Adet = Target.Value For X = Target.Offset(, 1).Column To Cells(1, Columns.Count).End(1).Column Adet = Int(Adet * 0.9) For Y = X To Cells(1, Columns.Count).End(1).Column If (WorksheetFunction.Sum(Range(Cells(4, Y), Cells(Rows.Count, Y))) + Adet) > Cells(1, Y) Then Cells(Target.Row, Y) = 0 Else Cells(Target.Row, Y) = Adet Exit For End If Next Adet = Cells(Target.Row, Y) Next End If 10 Application.EnableEvents = True End Sub

Korhan Ayhan' Alıntı:

Kodları sayfanın kod bölümüne uygulayıp deneyiniz.

Çoklu veri girişinde çalışmaz.

Deneyin. Olmayan yeri varsa revize ederiz.

C++:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim X As Integer, Y As Integer, Son As String, Adet As Double
   
    On Error GoTo 10
   
    Son = Cells(Rows.Count, Cells(1, Columns.Count).End(1).Column).Address(0, 0)

    If Intersect(Target, Range("B4:" & Son)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
   
    Application.EnableEvents = False
   
    If IsNumeric(Target) And Not IsEmpty(Target) Then
        Target.Offset(, 1).Resize(1, Columns.Count - Target.Column).ClearContents
        If Target.Value > Cells(1, Target.Column) Then
            MsgBox "Maksimum adetten büyük değer girmeyiniz!", vbCritical
            Target.ClearContents
            GoTo 10
        End If
               
        If WorksheetFunction.Sum(Range(Cells(4, Target.Column), Cells(Rows.Count, Target.Column))) > Cells(1, Target.Column) Then
            MsgBox "Sütun toplamı maksimum adetten büyük olamaz!" & vbCr & vbCr & "Değer silinecektir.", vbCritical
            Target.ClearContents
            GoTo 10
        End If
       
        Adet = Target.Value
       
        For X = Target.Offset(, 1).Column To Cells(1, Columns.Count).End(1).Column
            Adet = Int(Adet * 0.9)
            For Y = X To Cells(1, Columns.Count).End(1).Column
                If (WorksheetFunction.Sum(Range(Cells(4, Y), Cells(Rows.Count, Y))) + Adet) > Cells(1, Y) Then
                    Cells(Target.Row, Y) = 0
                Else
                    Cells(Target.Row, Y) = Adet
                    Exit For
                End If
            Next
            Adet = Cells(Target.Row, Y)
        Next
    End If

10  Application.EnableEvents = True
End Sub

Hocam Elinize sağlık kontrollerini yapıyorum çok teşekkür ederim.

ufukufuk01 · 25 Şubat 2021

ufukufuk01' Alıntı:
Hocam Elinize sağlık kontrollerini yapıyorum çok teşekkür ederim.

Hocam sadece yukarıyuvarla yapabilirsek yeterli çünkü örnek hücreye 20 sayısı girer ise sayı %10 düşe düşe 1 kalıyor (buraya kadar tam sayı olması koşulu tamam) ondan sonraki hücreler ise 0 olarak geliyor eğer yukarı yuvarlama olur ise 1 sayısının %10 düşük hali 0,90 olacak yukarı yuvarla ile de oda 1 gelecek diye düşünüyorum
WorksheetFunctio.Sum değişgenini
WorksheetFunction.Roundup olarak güncellemedim ama bir yerlerini eksik bıraktım düşüncesindeyim olmadı.

ufukufuk01 · 25 Şubat 2021

Korhan Ayhan' Alıntı:

Kodları sayfanın kod bölümüne uygulayıp deneyiniz.

Çoklu veri girişinde çalışmaz.

Deneyin. Olmayan yeri varsa revize ederiz.

C++:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim X As Integer, Y As Integer, Son As String, Adet As Double
   
    On Error GoTo 10
   
    Son = Cells(Rows.Count, Cells(1, Columns.Count).End(1).Column).Address(0, 0)

    If Intersect(Target, Range("B4:" & Son)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
   
    Application.EnableEvents = False
   
    If IsNumeric(Target) And Not IsEmpty(Target) Then
        Target.Offset(, 1).Resize(1, Columns.Count - Target.Column).ClearContents
        If Target.Value > Cells(1, Target.Column) Then
            MsgBox "Maksimum adetten büyük değer girmeyiniz!", vbCritical
            Target.ClearContents
            GoTo 10
        End If
               
        If WorksheetFunction.Sum(Range(Cells(4, Target.Column), Cells(Rows.Count, Target.Column))) > Cells(1, Target.Column) Then
            MsgBox "Sütun toplamı maksimum adetten büyük olamaz!" & vbCr & vbCr & "Değer silinecektir.", vbCritical
            Target.ClearContents
            GoTo 10
        End If
       
        Adet = Target.Value
       
        For X = Target.Offset(, 1).Column To Cells(1, Columns.Count).End(1).Column
            Adet = Int(Adet * 0.9)
            For Y = X To Cells(1, Columns.Count).End(1).Column
                If (WorksheetFunction.Sum(Range(Cells(4, Y), Cells(Rows.Count, Y))) + Adet) > Cells(1, Y) Then
                    Cells(Target.Row, Y) = 0
                Else
                    Cells(Target.Row, Y) = Adet
                    Exit For
                End If
            Next
            Adet = Cells(Target.Row, Y)
        Next
    End If

10  Application.EnableEvents = True
End Sub

Hocam sadece yukarıyuvarla yapabilirsek yeterli çünkü örnek hücreye 20 sayısı girer ise sayı %10 düşe düşe 1 kalıyor (buraya kadar tam sayı olması koşulu tamam) ondan sonraki hücreler ise 0 olarak geliyor eğer yukarı yuvarlama olur ise 1 sayısının %10 düşük hali 0,90 olacak yukarı yuvarla ile de oda 1 gelecek diye düşünüyorum
WorksheetFunctio.Sum değişgenini
WorksheetFunction.Roundup olarak güncellemedim ama bir yerlerini eksik bıraktım düşüncesindeyim olmadı.

ufukufuk01 · 25 Şubat 2021

Merhabalar Hocam

Adet = Int(Adet * 0.9 + 0.1 ) ekledim sorunum kalmadı teşekkürler

maximum değeri gecemez

ufukufuk01

İndir max gecemez

Korhan Ayhan

Administrator

ufukufuk01

ufukufuk01

Korhan Ayhan

Administrator

ufukufuk01

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

ufukufuk01

ufukufuk01

ufukufuk01

ufukufuk01