Tek Formülü Makroyla Sütunlara Uygulamak ?

[koleksiyoncu1980]

Adet miktarının min. max daki faktörü nedir? Sorularınızı detaylı açıklamanızı rica ederim.

adet miktarında sayılar var bu sayılara göre "sayfa" sayfasında girilen verilerin yine "sayfa" sayfasında B sütununda bulunan karşılıklarının min-max değerleri "min-max" sayfasında A v B sütunlarında görüntülenecek.örneğin yüksek bir puan eklendiğinde bu adet miktarını aşmayacak ve buna bağlı olarak min-max değerleri yeniden düzenlenecek

yeni bir örnek dosya yaptım bakabilirsiniz
ve son olarak bunu google dokümanlara aktarmak istiyorum

 

[Ömer]

Eklediğiniz tabloda anlayabileceğim türden bir açıklama yok. Sadece veri var.

=büyük(aralık, d sütundaki adet)
=küçük(aralık, d sütundaki adet)

D sütunu bu işemi yarayacak?

 

[koleksiyoncu1980]

Eklediğiniz tabloda anlayabileceğim türden bir açıklama yok. Sadece veri var.

=büyük(aralık, d sütundaki adet)
=küçük(aralık, d sütundaki adet)

D sütunu bu işemi yarayacak?

max= d sütundaki adet miktarınca en büyük sayı (tavan)
min = d sütunundaki adet miktarınca en küçük sayı ( taban)

böylece yeni veriler girdikçe min-max değerleri D sütunundaki adet miktarlarını aşmayacak şekilde değişecek yani taban-tavan değerleri değişmiş olacak

 

[Ömer]

Eski kodları silerek aşağıdakileri kullanın.

Google dökümanla deneme yapmamıştım. Dilerseniz bu konuyu yeni konu başlığı altında sorunuz.

Option Base 1
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim Sm As Worksheet, c As Range, Adr As String, Adet As Long
    Dim dizi() As Double, i As Long, k As Long
 
    If Intersect(Target, Range("E2:AH" & Rows.Count)) Is Nothing Then Exit Sub
 
    Set Sm = Sheets("min-max")
 
    Application.ScreenUpdating = False
    Sm.Range("A2:B" & Rows.Count).ClearContents
 
    With Range("E2:AH" & Rows.Count)
        For i = 2 To Sm.Cells(Rows.Count, "C").End(xlUp).Row
            Adet = 0
            Set c = .Find(Sm.Cells(i, "C"), , xlValues, xlWhole)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    Adet = Adet + 1
                    ReDim Preserve dizi(Adet)
                    dizi(Adet) = Cells(c.Row, "B")
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
 
            If Sm.Cells(i, "D") > Adet Then k = Adet Else k = Sm.Cells(i, "D")
 
            If Adet <> 0 Then Sm.Cells(i, "A") = WorksheetFunction.Small(dizi, k)
            If Adet <> 0 Then Sm.Cells(i, "B") = WorksheetFunction.Large(dizi, k)
 
        Next i
    End With
 
End Sub

.

 

[koleksiyoncu1980]

siz dosyaya uygulayarak buraya ekleyebilir misiniz ben yapamadım da
kusura bakmayın

 

[Ömer]

siz dosyaya uygulayarak buraya ekleyebilir misiniz ben yapamadım da
kusura bakmayın

Dosyanız ektedir.

.

 

[koleksiyoncu1980]

Dosyanız ektedir.

.

kusura bakmayın sizi uğraştırdım ama malesef olmamış. neyse zaten google dökümanlara entegre olup olmayacağı da meçhul daha fazla uğraşmayalım

tekrar sağolun yardımlarınız için teşekkür ederim