Soru En iyi değeri bulma!!!

[kotto]

Merhaba
Bir makinemiz var. Makine her gün açılışta farklı değerler gösteriyor. -400 den +400 e kadar. Şimdiye kadar bu değerlerin dışına çıktığını görmedik.

Makinemiz aynı anda 4 farklı ürün üretiyor. Daha fazla ürün de üretebiliyor ama biz 4-6 arası ürün ürettiriyoruz.

Ürün kodlarımız
-1
1
-1s
1s

Makinenin her sabah açılıştaki gösterge değerine göre çıkan mamulün kalitesi ürün bazında değişiklik gösteriyor.

Örneğin;

1.gün

Makine göstergesi : 96
Ürünler : -1, 1,-1s,1s
Kalite Puanı (Normal değer 0) -1 = 1,55 | 1 = 0,37 | -1s = -0,87 - | 1s = -0,24


2.gün

Makine göstergesi : -49
Ürünler : -1, 1,-1s,1s
Kalite Puanı (Normal değer 0) -1 = -0,81| 1 = 1,52 | -1s = -0,14 - | 1s = 1,78


Her gün makinedeki değeri ve ürünlerin kalite puanlarını not ediyoruz. Amacımız yılın sonunda makineyi açtığımızda ekranda 74 yazıyorsa, excel de 74 yazdığımızda bu sayıya en yakın değer daha önce kaç ise o tarihte en iyi kaliteyi hangi üründen aldığımızı görmek. İyiden kötüye doğru sıralanması.

Böyle bir çalışma konusunda yarımcı olabilecek birileri varsa yardımınızı rica ediyorum.

Örnek Dosya :

Drive https://drive.google.com/file/d/1Y7YdplPiTiGyMy98RGcbVCzHHcRYQuTZ/view?usp=sharing
2. Seçenek : https://www.dosyaupload.com/qYfW

Saygılarımla

 

[Ömer BARAN]

Merhaba.
Cevabımın altındaki İMZA bölümünü okuyunuz.

 

[kotto]

Merhaba.
Cevabımın altındaki İMZA bölümünü okuyunuz.

Özür dilerim. Örnek dosyayı ekledim.

 

[kotto]

Yardımcı olabilecek yok sanırım

 

[kulomer46]

Merhaba
En iyi kalite için 0 (Sıfır) yada Sıfıra an yakın olmakmı gerekiyor. Yoksa + en yüksek rakam en iyi kalite anlamında mıdır.
Yani
Kalite Puanı (Normal değer 0) -1 = 0,00| 1 = 1,52 | -1s = -0,14 - | 1s = 1,78
burada en iyi kalite -1 = 0,00 mıdır. Yoksa 1s = 1,78 midir.

En yüksek Kalite 0 (Sıfır) 'a yaklaştıkça mı gerçekleşiyor?

 

[kotto]

Merhaba
En iyi kalite için 0 (Sıfır) yada Sıfıra an yakın olmakmı gerekiyor. Yoksa + en yüksek rakam en iyi kalite anlamında mıdır.
Yani
Kalite Puanı (Normal değer 0) -1 = 0,00| 1 = 1,52 | -1s = -0,14 - | 1s = 1,78
burada en iyi kalite -1 = 0,00 mıdır. Yoksa 1s = 1,78 midir.

En yüksek Kalite 0 (Sıfır) 'a yaklaştıkça mı gerçekleşiyor?

0 dan büyük değerler arttıkça kalitenin arttığı anlamına geliyor. 0 dan küçükler, yani - değerler kalitenin azaldığı anlamına geliyor.

vba yaptım ama isteğim gibi çalıştıramıyorum.

Amacım; her günkü değerleri dosyay kaydedip, 1 yıl sonra dosyada makinenin bugünkü değeri olan "86" yı dosya içerisinde aradığımda, herhangi bir günde 86 değerinin görüldüğü veya bu değere en yakın değerin yazıldığı gün ürün kalite değerlerini görmek.

 

[kulomer46]

Tamam anladım.
Fakat örnek dosyanız olsaydı direkt programı örnek dosyanıza yazardık. daha iyi olurdu.
Kurum internetim #1 nolu mesajınızdaki bağlantıyı açmama izin vermiyor.

 

[kotto]

Tamam anladım.
Fakat örnek dosyanız olsaydı direkt programı örnek dosyanıza yazardık. daha iyi olurdu.
Kurum internetim #1 nolu mesajınızdaki bağlantıyı açmama izin vermiyor.

örnek dosyayı farklı bir yere daha yükledim.

 

[kulomer46]

Merhaba
Dosyalarınızın olduğu bağlantıları kurum internetim açmıyor. Bende aşağıdaki çözümü buldum.
Excel dosyanızı aşağıdaki şekilde dizayn ediniz. Ekleyeceğiniz makro koduda aşağıdadır.
En yakın değerler yukardan aşağıya sıralanmaktadır.
Bende sorunsuz çalışıyor.

Hazır Dosya Ek'tedir.
Selamlar...




Sub En_İyileri_Sırala()
'15.01.2019 11:10

For k = 7 To 14
Columns(k).ClearContents
Next

bul1 = InputBox("Aranan Değeri Giriniz", , 75)

If bul1 > 400 Or bul1 < -400 Then
MsgBox "Aranan Değer +400 ile -400 arasında bir sayı olmalıdır"
End

End If


Cells(1, 7) = "Aranan Değer "
Cells(1, 8) = bul1

Cells(1, 7).Interior.Color = RGB(255, 192, 0)
Cells(1, 8).Interior.Color = RGB(255, 192, 0)

Application.ScreenUpdating = False


sona = Cells(65500, 1).End(xlUp).Row

ReDim dizi(sona, 5)

Cells(2, 7) = "Bulunduğu" & Chr(10) & "Satır No"
Cells(2, 8) = "Makine" & Chr(10) & "Göstergesi"
Cells(2, 9) = "'-1"
Cells(2, 10) = "'1"
Cells(2, 11) = "'-1s"
Cells(2, 12) = "'1s"
Cells(2, 13) = "Ürün" & Chr(10) & "Toplamı"
Cells(2, 14) = "FARK"

For i = 3 To sona

dizi(i, 1) = Cells(i, 1) ' Makine Göstergesi

dizi(i, 2) = Cells(i, 2) + Cells(i, 3) + Cells(i, 4) + Cells(i, 5) ' Ürünler Toplam Değer
If dizi(i, 2) < 0.0009 And dizi(i, 2) > -0.0009 Then dizi(i, 2) = 0

dizi(i, 3) = Abs(bul1 - Cells(i, 1)) 'Aranan Değer ile Makina Göstergesi Farkı

dizi(i, 4) = i

Cells(i, 7) = i
Cells(i, 8) = dizi(i, 1)

Cells(i, 9) = Cells(i, 2)
Cells(i, 10) = Cells(i, 3)
Cells(i, 11) = Cells(i, 4)
Cells(i, 12) = Cells(i, 5)

Cells(i, 13) = dizi(i, 2)
Cells(i, 14) = dizi(i, 3)


Next


Range("K3").Select
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
"N3:N" & sona), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
"M3:M" & sona), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("G2:N" & sona)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("K8").Select

Columns("G:N").EntireColumn.AutoFit


Application.ScreenUpdating = True

MsgBox "İşlem Tamamlandı."

End Sub

 

[kotto]

Merhaba
Dosyalarınızın olduğu bağlantıları kurum internetim açmıyor. Bende aşağıdaki çözümü buldum.
Excel dosyanızı aşağıdaki şekilde dizayn ediniz. Ekleyeceğiniz makro koduda aşağıdadır.
En yakın değerler yukardan aşağıya sıralanmaktadır.
Bende sorunsuz çalışıyor.

Hazır Dosya Ek'tedir.
Selamlar...

Ekli dosyayı görüntüle 202093


Sub En_İyileri_Sırala()
'15.01.2019 11:10

For k = 7 To 14
Columns(k).ClearContents
Next

bul1 = InputBox("Aranan Değeri Giriniz", , 75)

If bul1 > 400 Or bul1 < -400 Then
MsgBox "Aranan Değer +400 ile -400 arasında bir sayı olmalıdır"
End

End If


Cells(1, 7) = "Aranan Değer "
Cells(1, 8) = bul1

Cells(1, 7).Interior.Color = RGB(255, 192, 0)
Cells(1, 8).Interior.Color = RGB(255, 192, 0)

Application.ScreenUpdating = False


sona = Cells(65500, 1).End(xlUp).Row

ReDim dizi(sona, 5)

Cells(2, 7) = "Bulunduğu" & Chr(10) & "Satır No"
Cells(2, 8) = "Makine" & Chr(10) & "Göstergesi"
Cells(2, 9) = "'-1"
Cells(2, 10) = "'1"
Cells(2, 11) = "'-1s"
Cells(2, 12) = "'1s"
Cells(2, 13) = "Ürün" & Chr(10) & "Toplamı"
Cells(2, 14) = "FARK"

For i = 3 To sona

dizi(i, 1) = Cells(i, 1) ' Makine Göstergesi

dizi(i, 2) = Cells(i, 2) + Cells(i, 3) + Cells(i, 4) + Cells(i, 5) ' Ürünler Toplam Değer
If dizi(i, 2) < 0.0009 And dizi(i, 2) > -0.0009 Then dizi(i, 2) = 0

dizi(i, 3) = Abs(bul1 - Cells(i, 1)) 'Aranan Değer ile Makina Göstergesi Farkı

dizi(i, 4) = i

Cells(i, 7) = i
Cells(i, 8) = dizi(i, 1)

Cells(i, 9) = Cells(i, 2)
Cells(i, 10) = Cells(i, 3)
Cells(i, 11) = Cells(i, 4)
Cells(i, 12) = Cells(i, 5)

Cells(i, 13) = dizi(i, 2)
Cells(i, 14) = dizi(i, 3)


Next


Range("K3").Select
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
"N3:N" & sona), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
"M3:M" & sona), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("G2:N" & sona)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("K8").Select

Columns("G:N").EntireColumn.AutoFit


Application.ScreenUpdating = True

MsgBox "İşlem Tamamlandı."

End Sub

süper ve sorunsuz çalışıyor. eline koluna emeğine sağlık

 

[kulomer46]

süper ve sorunsuz çalışıyor. eline koluna emeğine sağlık

Selamlar...