Matematik Soru'sunun Vba ile çözümü mümkünmdür?

Kemal Demir

Özel Üye
Katılım
29 Temmuz 2004
Mesajlar
2,108
İyi günler arkadaşlar.

7 basamaklı bir sayının ; örnek: 1234567

son 4 rakamı blok olarak ilk dort rakamın yerine geçecek ve sonuc 2 katının 1 fazlası olacak.

Acıklayıcı olması için örnek yazıyorum.

Örnek:
7654321 / 4321765 = 2katının 1 fazlası olacak

Bu işlemin Vba ile yapılabilmesi olasımıdır?

Teşekkurler.
 

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,420
Excel Vers. ve Dili
excel 2010
merhaba
Kemal bey, aşağıdaki formülü vba ya dönüştürseniz olur mu?

=(SAĞDAN(A1;4)&SOLDAN(A1;3))*2+1

Kod:
Sub Makro1()
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "=(RIGHT(RC[-1],4)&LEFT(RC[-1],3))*2+1"
    Range("A1").Select
End Sub
 

Kemal Demir

Özel Üye
Katılım
29 Temmuz 2004
Mesajlar
2,108
Süleyman bey,

Deneyip sonucu soyleyeceğim.

Kod:
For x=1 to 1
Cells(x,2)=(left(Cells(x,1),4)&right(Cells(x,1),3))*2+1
next
Teşekkurler.
 

leumruk

Uzman
Uzman
Katılım
15 Nisan 2007
Mesajlar
3,472
Excel Vers. ve Dili
Office 2010 & 2013 tr
Selamlar,
Eğer doğru anlamışsam aşağıdaki kod sonuca ulaştırıyor. Yalnız sonucu bulması epey uzun sürüyor.
Kod:
Sub dene()
Randomize
Tekrar:
Sayi = Int(Rnd * 9999999 + 1)
If Sayi < 1000000 Then GoTo Tekrar
Cells(1, 3) = Sayi
Cells(1, 1) = Right(Sayi, 4) & Left(Sayi, 3)
If Cells(1, 1) = Cells(1, 3) * 2 + 1 Then Exit Sub
GoTo Tekrar
End Sub
Başka bir alternatif:
Kod:
Sub Yeni()
[a1] = 1000000
Tekrar:
[c1] = Right([a1], 4) & Left([a1], 3)
If [c1] = [a1] * 2 + 1 Or a = 9999999 Then
Exit Sub
End If
[a1] = [a1] + 1
GoTo Tekrar
End Sub
Sayıları tek tek artırıp kontrol ediyor. Diğerine göre daha kısa sürüyor.
Epey bir beklemeden sonra 4358717 sonucunu elde ettim. Sonuç 8717435
 
Son düzenleme:

Kemal Demir

Özel Üye
Katılım
29 Temmuz 2004
Mesajlar
2,108
süleyman bey ,

Öncelkle ilginiz için teşekkurler.Sonucu görünce doğru oldugu kanısında idim ama yalnız ben ne istediğimi unutmus olsam gerek :)Tekrar teiekkurler.

Sn.leumruk deneyip sonucu foruma yazacagım.

İyi akşamlar.
 

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,420
Excel Vers. ve Dili
excel 2010
Süleyman bey,

Deneyip sonucu soyleyeceğim.

Kod:
For x=1 to 1
Cells(x,2)=(left(Cells(x,1),4)&right(Cells(x,1),3))*2+1
next
Teşekkurler.
merhaba
Kemal bey, sanırım aşağıdaki gibi olması lazım

Kod:
Cells(x, 4) = (Right(Cells(x, 1), 4) & Left(Cells(x, 1), 3)) * 2 + 1
 
Katılım
28 Nisan 2005
Mesajlar
252
Excel Vers. ve Dili
Excel 2010 Türkçe
Merhaba

Bide böyle deneyin sonuca ulaşırsınız.

Kod:
Sub BUL()
For a = 1 To 9
For b = 1 To 9
For c = 1 To 9
For d = 1 To 9
For e = 1 To 9
For f = 1 To 9
For g = 1 To 9
    If 2 * (a * 1000000 + b * 100000 + c * 10000 + d * 1000 + e * 100 + f * 10 + g) + 1 = (d * 1000000 + e * 100000 + f * 10000 + g * 1000 + a * 100 + b * 10 + c) * 1 Then
        MsgBox a * 1000000 + b * 100000 + c * 10000 + d * 1000 + e * 100 + f * 10 + g
    End If
Next: Next: Next: Next: Next: Next: Next
End Sub
 

leumruk

Uzman
Uzman
Katılım
15 Nisan 2007
Mesajlar
3,472
Excel Vers. ve Dili
Office 2010 & 2013 tr
Evet, doğru. Syn. algil,
Tebrik ederim. Matematiksel mantığına göre yapmışsınız. Kısa sürede çözüme ulaştı. Zekice bir çözüm.
 
Üst