Faktöriyel Yazdırma

[kvsr_20_basak]

On basamaklı bir sayının rakamları toplamı 10'dan küçükse 10'a kadar, eğer toplamı 25'den büyük ise 25'e kadar olan sayıların faktöriyelini hesaplayan ve ekrana yazdıran akış diyagramı ve excel visual basic programındaki kodu nedir?

 

[hmtstc]

Sub hesapla()
Dim sayı(10) As Integer
Dim a, b As Double

deger = Cells(1, 1)
sayı(1) = Mid(deger, 1, 1)
sayı(2) = Mid(deger, 2, 1)
sayı(3) = Mid(deger, 3, 1)
sayı(4) = Mid(deger, 4, 1)
sayı(5) = Mid(deger, 5, 1)
sayı(6) = Mid(deger, 6, 1)
sayı(7) = Mid(deger, 7, 1)
sayı(8) = Mid(deger, 8, 1)
sayı(9) = Mid(deger, 9, 1)
sayı(0) = Mid(deger, 10, 1)

toplam = sayı(1) + sayı(2) + sayı(3) + sayı(4) + sayı(5) + sayı(6) + sayı(7) + sayı(8) + sayı(9) + sayı(10)

If toplam < 10 Then
    b = 1
    For a = 1 To 10
    b = b * a
    Next
    sonuc = b
End If

If toplam > 25 Then
    b = 1
    For a = 1 To 25
    b = b * a
    Next
    sonuc = b
End If
MsgBox sonuc
End Sub

 

[etopcu_]

Sub hesapla()
Dim sayı(10) As Integer
Dim a, b As Double

deger = Cells(1, 1)
sayı(1) = Mid(deger, 1, 1)
sayı(2) = Mid(deger, 2, 1)
sayı(3) = Mid(deger, 3, 1)
sayı(4) = Mid(deger, 4, 1)
sayı(5) = Mid(deger, 5, 1)
sayı(6) = Mid(deger, 6, 1)
sayı(7) = Mid(deger, 7, 1)
sayı(8) = Mid(deger, 8, 1)
sayı(9) = Mid(deger, 9, 1)
sayı(0) = Mid(deger, 10, 1)

toplam = sayı(1) + sayı(2) + sayı(3) + sayı(4) + sayı(5) + sayı(6) + sayı(7) + sayı(8) + sayı(9) + sayı(10)

If toplam < 10 Then
    b = 1
    For a = 1 To 10
    b = b * a
    Next
    sonuc = b
End If

If toplam > 25 Then
    b = 1
    For a = 1 To 25
    b = b * a
    Next
    sonuc = b
End If
MsgBox sonuc
End Sub

10 basamaklı sayıyı nereye ve nasıl şekilde yazmamız gerekiyor yardımcı olur musunuz

 

[hmtstc]

10 basamaklı sayıyı nereye ve nasıl şekilde yazmamız gerekiyor yardımcı olur musunuz

A1 hücresinde yazılı olduğunu kabul ettim.

eğer A1 değil ise formülde deger = cells(1,1) yazıyor. burada satır sütun noları yazınız. B4 ise örneğin cells(4,2) yazabilirsiniz.

 

[rlr]

On basamaklı bir sayının rakamları toplamı 10'dan küçükse 10'a kadar, eğer toplamı 25'den büyük ise 25'e kadar. 10 ile 25 arasındaysa olduğu sayı kadar (yani sayı 16 ise 16'ya kadar) faktöriyelini hesaplayan excel visual basic kodu nedir?
[ve on basamaklı sayının son hanesi çift ise tek faktöriyelleri almıyoruz, tam tersi de son hanesi tek olanlar için geçerli.]
{ve sadece o sayının faktöriyeli değil o sayıya kadar 16'ysa 2!=2, 4!=24, ....... 16!= gibi olacak}

 

[veyselemre]

Sub test()
    Dim sayi As Long
    Dim i As Byte
    Dim topla As Integer
    Dim sonuc As Double
    sayi = Range("A1").Value
    For i = 1 To 10
        topla = topla + Val(Mid(sayi, i, 1))
    Next i
    If topla > 25 Then
        fak = 25
    ElseIf topla > 10 Then fak = topla
    Else
        fak = 10
    End If
    sonuc = 1
    For i = 2 To fak
        sonuc = sonuc * i
    Next i
    MsgBox "Rakamlar toplami = " & topla & vbCr & fak & "!= " & Format(sonuc, "#,##0")
End Sub

 

[rlr]

Sub test()
    Dim sayi As Long
    Dim i As Byte
    Dim topla As Integer
    Dim sonuc As Double
    sayi = Range("A1").Value
    For i = 1 To 10
        topla = topla + Val(Mid(sayi, i, 1))
    Next i
    If topla > 25 Then
        fak = 25
    ElseIf topla > 10 Then fak = topla
    Else
        fak = 10
    End If
    sonuc = 1
    For i = 2 To fak
        sonuc = sonuc * i
    Next i
    MsgBox "Rakamlar toplami = " & topla & vbCr & fak & "!= " & Format(sonuc, "#,##0")
End Sub

Kod çalışıyo ama sadece rakamlarının toplamı olan sayının faktöriyelini gösteriyo. Mesela "A1"e yazıcağım sayının son basamağı çift ise o sayıya kadar olan bütün çift sayıların faktöriyelini de ekranda göstermeli. Örneğin sayımız '23456' rakamları toplamı 20 olur ve son basamağı çift o zaman 2!,4!,6!,8!,10!,12!,14!,16!,18!,20! hepsinin faktöriyelinin sonucunu ekranda göstermeli.

 

[veyselemre]

Sub test()
    Dim sayi As Long
    Dim i As Byte
    Dim topla As Integer
    Dim sonuc As Double

    sayi = Range("A1").Value
    For i = 1 To 10
        topla = topla + Val(Mid(sayi, i, 1))
    Next i

    If topla > 25 Then
        fak = 25
    ElseIf topla > 10 Then fak = topla
    Else
        fak = 10
    End If
   
    sonuc = 1

    For i = 1 To fak
        sonuc = sonuc * i
        If (-1) ^ i = (-1) ^ sayi Then msg = msg & vbCr & i & "!= " & Format(sonuc, "#,##0")
    Next i

    MsgBox "Rakamlar toplami = " & topla & vbCr & msg
End Sub

 

[mancubus]

ödev mi?

 

[Korhan Ayhan]

Büyük ihtimalle...

 

[ovgen]

bunun excel gösterimi varmı

 

[Tevfik_Kursun]

Merhaba Veysel Emre Hocam,
8. mesajdaki makroda;
son rakamın çift ya da tek olduğunu nerede belirliyorsunuz?
mesaj kutusuna yazdıracağınıza C1 den itibaren C sütununa 1 arttırarak yazdırır mısınız?
Saygılarımla

 

[ahmetyildirim]

kod işime yaradı teşekkürler.

 

[veyselemre]

mesaj kutusuna yazdıracağınıza C1 den itibaren C sütununa 1 arttırarak yazdırır mısınız?

Sub test()
    Dim sayi As Long
    Dim i As Byte
    Dim topla As Integer
    Dim sonuc As Double
    Dim sat As Byte

    sayi = Range("A1").Value
    For i = 1 To 10
        topla = topla + Val(Mid(sayi, i, 1))
    Next i

    If topla > 25 Then
        fak = 25
    ElseIf topla > 10 Then fak = topla
    Else
        fak = 10
    End If

    sonuc = 1

    For i = 1 To fak
        sonuc = sonuc * i
        If (-1) ^ i = (-1) ^ sayi Then
            sat = sat + 1
            Cells(sat, "C").Value = i & "!= " & Format(sonuc, "#,##0")
        End If
    Next i

End Sub

son rakamın çift ya da tek olduğunu nerede belirliyorsunuz?

If (-1) ^ i = (-1) ^ sayi Then

Faktöryeli bulmak için kullandığımız döngüde i değeri tek/çift (-1)^i ile tesbit ediyoruz. Aynı şekilde sayımızın da tek/çift olduğunu tesbit ederek i ve sayının tek/çift değeri eşitse faktöryel değerini alıyoruz, yoksa pas geçiyoruz.

 

[Tevfik_Kursun]

Merhaba Sayın Veysel Hocam,
İlginize çok teşekkür ederim. Çok haklısınız

If (-1) ^ i = (-1) ^ sayi Then

satırı kendime göre dillendirmemişim.
Saygılarımla