Soru OKEK OBEB HESABI

downsoon · 10 Nisan 2023

Selamlar;

Ekteki tabloda E ve F sütunlarına kişilerin hisse oranlarını yazdığımda değişken oranlı da olsalar yan hücrelerinde okek alabiliyorum. Ancak 2 adet eksiğim var:

1- G16 hücresindeki gibi virgüllü sayı çıkıyor, bunu tam sayı haline getirebilir miyim okek olarak
2- C18 e vekil yazdığımda bunun anlamı üstünde yeralan kişilerin vekille temsil edildiği. Burada oran yazmamam gerekiyor. Ama yazmazsam okek formülü hata veriyor. Bu yüzden vekil yazan yerlere, yani E18 ve F18 hücrelerine 5 yazdım geçtim. Buraya değer girmeden Okek in hesaplama yapmasını sağlayabilir miyim.

Şimdiden teşekkürler

Korhan Ayhan · 10 Nisan 2023

Merhaba,

Dosyanızı açınca ben İngilizce sürüm kullandığım için H15 hücresinde LCM diye bir fonksiyon var. Bu tam olarak ne işlem yapıyor.

Ayrıca sonucu tamsayı görmek için aşağıdaki formülü G15 hücresine uygulayabilirsiniz.

=EĞER(C15="VEKİL";"";EĞER(C15="";"";YUVARLA(H15/F15*E15;0)))

downsoon · 10 Nisan 2023

H15 hücresindeki formül aşağıdaki formül

=EĞER(C15="VEKİL";"";EĞER(C15="";"";OKEK(DOLAYLI("$F$15:F"&BAĞ_DEĞ_DOLU_SAY($E$15:$E$42)+14))))

Amacım tamsayı olarak görmek değil. Mesela alttaki gibi 3. sütunda virgüllü ibare olmayacak şekilde tamsayıya tamamlayacak şekilde okek alabilmesini istiyorum

HİSSE PAYI	HİSSE PAYDASI	OKEK PAYI	OKEK PAYDASI

2	10	40	200
1,3	10	26	200
1,8	10	36	200

1	5	40	200
1	10	20	200

1	20	10	200
1	20	10	200
1,8	20	18	200

Korhan Ayhan · 11 Nisan 2023

Bu durumda örnek dosyanızda nasıl sonuç görmek istiyorsanız onu paylaşın onun üzerinde çözüm arayalım.

downsoon · 11 Nisan 2023

Elde etmek istediğim sonuç ekteki gibi:

E F sütunlarında tamsayı olmayan 1,3 ve 1,8 değerleri var.
Bunları G H sütunlarında tamsayı haline getirdim.
I J sütununda OKEK i G H sütunlarına göre yaptım.

Amacım G H üzerinde işlem yapmadan direk E F sütunlarındaki değerler üzerinden tamsayı halinde OKEK hesabı yaptırmak.

Korhan Ayhan · 11 Nisan 2023

Son paylaştığınız verilerde H sütununda bulduğunuz 200 değerinin OKEK dışında hesaplama mantığı nedir?

veyselemre · 11 Nisan 2023

Kod:

Sub test()
    Dim i%, sayi, son, x, okek, katsayi
    son = Cells(43, 5).End(3).Row
    ReDim paylar(15 To son) As Double, paydalar(15 To son) As Double
    x = 14

    For i = 15 To son
        sayi = Cells(i, 5).Value
        If sayi <> "" And IsNumeric(sayi) Then
            x = x + 1
            paylar(x) = sayi
            paydalar(x) = Cells(i, 6).Value
            Do While Int(paylar(x)) <> paylar(x)
                paylar(x) = paylar(x) * 10
                paydalar(x) = paydalar(x) * 10
            Loop

        End If
    Next i

    ReDim Preserve paydalar(15 To x)
    okek = WorksheetFunction.Lcm(paydalar)

    For i = 15 To son
        sayi = Cells(i, 5).Value
        If sayi <> "" And IsNumeric(sayi) Then
            katsayi = okek / Cells(i, 6).Value
            Cells(i, 7).Value = katsayi * sayi
            Cells(i, 8).Value = okek
        End If
    Next i

End Sub

downsoon · 11 Nisan 2023

Korhan Ayhan' Alıntı:
Son paylaştığınız verilerde H sütununda bulduğunuz 200 değerinin OKEK dışında hesaplama mantığı nedir?

200 ü yanlış hesaplamışım. Tamsayı haline getirince ortak çarpan 100 oluyor. Tabloyu bu şekilde güncelledim.

downsoon · 11 Nisan 2023

veyselemre' Alıntı:

Kod:

Sub test()
    Dim i%, sayi, son, x, okek, katsayi
    son = Cells(43, 5).End(3).Row
    ReDim paylar(15 To son) As Double, paydalar(15 To son) As Double
    x = 14

    For i = 15 To son
        sayi = Cells(i, 5).Value
        If sayi <> "" And IsNumeric(sayi) Then
            x = x + 1
            paylar(x) = sayi
            paydalar(x) = Cells(i, 6).Value
            Do While Int(paylar(x)) <> paylar(x)
                paylar(x) = paylar(x) * 10
                paydalar(x) = paydalar(x) * 10
            Loop

        End If
    Next i

    ReDim Preserve paydalar(15 To x)
    okek = WorksheetFunction.Lcm(paydalar)

    For i = 15 To son
        sayi = Cells(i, 5).Value
        If sayi <> "" And IsNumeric(sayi) Then
            katsayi = okek / Cells(i, 6).Value
            Cells(i, 7).Value = katsayi * sayi
            Cells(i, 8).Value = okek
        End If
    Next i

End Sub

Güzel çalışıyor, yüzdesel sağlamazsa hata veriyor. Bu güzel ama virgülden sonraki kısım artınca hata verdi. 1,3 ve 1,8 yerine 1,249 ve 1,851 kullandığımda " okek = WorksheetFunction.Lcm(paydalar)" satırı hata verdi

veyselemre · 12 Nisan 2023

Kod:

Sub test()
    Dim i%, sayi, son, x, okek, katsayi, obeb
    son = Cells(43, 5).End(3).Row
    ReDim paylar(15 To son) As Double, paydalar(15 To son) As Double
    x = 14

    For i = 15 To son
        sayi = Cells(i, 5).Value
        If sayi <> "" And IsNumeric(sayi) Then
            x = x + 1
            paylar(x) = sayi
            paydalar(x) = Cells(i, 6).Value
            If Int(paylar(x)) <> paylar(x) Then
                katsayi = Len(paylar(x)) - Len(Trim(Int(paylar(x))))
                paylar(x) = paylar(x) * 10 ^ katsayi
                paydalar(x) = paydalar(x) * 10 ^ katsayi
            End If
        End If
    Next i

    ReDim Preserve paydalar(15 To x)
    okek = WorksheetFunction.Lcm(paydalar)
    x = 14
    
    For i = 15 To son
        sayi = Cells(i, 5).Value
        If sayi <> "" And IsNumeric(sayi) Then
            x = x + 1
            katsayi = okek / Cells(i, 6).Value
            paylar(x) = katsayi * sayi
            paydalar(x) = okek
            Cells(i, 7).Value = paylar(x)
            Cells(i, 8).Value = okek
        End If
    Next i
    
    obeb = WorksheetFunction.Gcd(paylar, okek)
    For i = 15 To son
        sayi = Cells(i, 5).Value
        If sayi <> "" And IsNumeric(sayi) Then
            Cells(i, 7).Value = Cells(i, 7).Value / obeb
            Cells(i, 8).Value = Cells(i, 8).Value / obeb
        End If
    Next i

End Sub

downsoon · 12 Nisan 2023

veyselemre' Alıntı:

Kod:

Sub test()
    Dim i%, sayi, son, x, okek, katsayi, obeb
    son = Cells(43, 5).End(3).Row
    ReDim paylar(15 To son) As Double, paydalar(15 To son) As Double
    x = 14

    For i = 15 To son
        sayi = Cells(i, 5).Value
        If sayi <> "" And IsNumeric(sayi) Then
            x = x + 1
            paylar(x) = sayi
            paydalar(x) = Cells(i, 6).Value
            If Int(paylar(x)) <> paylar(x) Then
                katsayi = Len(paylar(x)) - Len(Trim(Int(paylar(x))))
                paylar(x) = paylar(x) * 10 ^ katsayi
                paydalar(x) = paydalar(x) * 10 ^ katsayi
            End If
        End If
    Next i

    ReDim Preserve paydalar(15 To x)
    okek = WorksheetFunction.Lcm(paydalar)
    x = 14
   
    For i = 15 To son
        sayi = Cells(i, 5).Value
        If sayi <> "" And IsNumeric(sayi) Then
            x = x + 1
            katsayi = okek / Cells(i, 6).Value
            paylar(x) = katsayi * sayi
            paydalar(x) = okek
            Cells(i, 7).Value = paylar(x)
            Cells(i, 8).Value = okek
        End If
    Next i
   
    obeb = WorksheetFunction.Gcd(paylar, okek)
    For i = 15 To son
        sayi = Cells(i, 5).Value
        If sayi <> "" And IsNumeric(sayi) Then
            Cells(i, 7).Value = Cells(i, 7).Value / obeb
            Cells(i, 8).Value = Cells(i, 8).Value / obeb
        End If
    Next i

End Sub

Elinize sağlık, testlerini yaptım çok iyi çalışıyor. Sadece ufak bir hata aldım

Range("G15:H42").Select
Selection.ClearContents

Baş tarafına bu kodu ekledim ve sorunsuz çalışıyor.

Emeğine sağlık, teşekkürler

Soru OKEK OBEB HESABI

downsoon

Ekli dosyalar

Korhan Ayhan

Administrator

downsoon

Korhan Ayhan

Administrator

downsoon

Ekli dosyalar

Korhan Ayhan

Administrator

veyselemre

Özel Üye

Ekli dosyalar

downsoon

downsoon

veyselemre

Özel Üye

downsoon

Ekli dosyalar