• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kuruş aktarma

  • Konbuyu başlatan Konbuyu başlatan mumu
  • Başlangıç tarihi Başlangıç tarihi
M

mumu

Katılım
2 Ocak 2006
Mesajlar
12
Selam arkadaşlar bana bir noktada yardımcı olursanız sevinirim. Yapmak istediğim hücrenin birine rakamı viregülden sonra iki rakamla yazdıktan sonra virgülü takip eden rakamların yan hücreye taşınarak ilk hücredeki ondalığın kendiliğinden silinmesi.
Ã?rnek:
A1: 10,54 (bunu biz giriyoruz)
B2: 54 (bunu kendisi taşıyor)
A1: 10 (ondalık kendiliğinden silinerek sadece tam sayı kalıyor)

Bir de yukarıdan aşağıya (yani B2 hücresine nakledilen bu ondalıkların aşağıya doğru toplandıktan sonra oluşan rakamı solundaki hücreye 100 üzerinden 1 tamsayıya çevirerek ve 100 üzerinden kalanı yine B hücresinde tutarak solundaki hücreye eklemesi.
Ã?rnek:
B20: 354 (Aşağıya doğru yukarıdaki hücrelerin toplamı)
A20: A1'den A19'a kadar olan hücre içeriği toplamı+ 3 ::> B20'den buraya nakledilen tam sayı
B20: 54 (A20'ye gönderilen 3 tamsayıdan sonra geriye kalan)

NOT: YTL ve YKR hesabı için tam sayı YKR ondalık ise YKR

Umarım anlatabilmişimdir. Yardımcı olursanız sevinirim
 
Bu forumda YTL,YKR çok işlendi bir aratın. Umarım pek çok bilgi bulursunuz.
 
Sn yurttas,
Bu konu ile alakalı değil gibi görünse de çok yakından ilgilendiren bi sorum var.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
xx = Target.Column
a = Target.Row - 1
If a <= 0 Then a = 1 Else
If Cells(a, xx + 1) = 0 Then 'bu kısımda da 2inci kolon seçilmiş
If Cells(a, xx) = 0 Then Exit Sub '1 kolon 0 ise çıkmış
Cells(a, xx + 1) = (100 * Cells(a, xx)) - (100 * Int(Cells(a, xx))) '2 kolona krş yazılmış
Cells(a, xx) = Int(Cells(a, xx)) '1 kolona ytl yazılmış ...
End If
End Sub

İlgili kodlara şu ilaveyi nasıl yapabiliriz?
"YTL yazdırılcak hücreyi seçtiğim zaman kodlar çalışmasın, hücre değişirse kodlar çalışsın ve YTL kısmı kullanıcı tarafından silinirse YKR kısmı da silinsin(gerçi bu son istediğimin olmasını istediğimden de emin değilim. Çünki malzeme sayılarını da rakamla yazıyoruz ve herhangi bir rakam sildiğimde sağındakini aynen uçuracak.)"
 
Sn acemi şu şekil bir formül uygula inşallah işine yarar.

B2 Hacresine Bu Formülü Yaz =EÐER(A1="";"";TAMSAYI(A1))
C2 Hücresine Bu Formülü yaz =EÐER(A1="";"";(A1-TAMSAYI(A1))*100)

Yani A1 Hücresine yazmış olduğun 10,54 rakamını
B2 Hücresine 10 ytl
C2 Hücresine 54 ykr yi atıyor.
 
sayın talatcd,
çok teşekkür ederim ancak benim uygulamam biraz farklı.
benim kodlarım sayesinde virgüllü olarak yazdığım tutar kendiliğinden kuruşu sağındaki haneye yazıyor ve bulunduğu hücreye de tamsayısını yazıyor.
ancak benim sorunum şu ki;
diyelim ki 123,75 yazdım A1'e
A1' 123
B1'e 75 yazıyor yazmasına da 75 yazan yere tıkladığımda C1'e 0 yazıyor. yani rakam yazan herhangi bir hücreye tıkladığınızda sağındaki hücreye kuruşu yazmaya çalışıyor. ben istiyorum ki hücreyi değiştirmediğim sürece kodlar çalışmasın.
Bir de; 123 ve 75 i yazdı diyelim. 10-15 gün sonra rakamı değiştirmem gerektiğinde yeni miktarı A1'e (A1'i hep örnek olsun diye söylüyorum aslında kastettiğim bütün sütun) yazdığımda bu sefer kodlar çalışmıyor çünki sağındaki hücre dolu.
Bu iki problemi bi türlü aşamıyorum çünki vba bilmiyorum.
 
benim kodlarım sayesinde virgüllü olarak yazdığım tutar kendiliğinden kuruşu sağındaki haneye yazıyor ve bulunduğu hücreye de tamsayısını yazıyor
Genişletmek için tıkla ...
Sayın aceminin söylemiş olduğu A1 hücresine yazılan küsuratlı rakamı nasıl dönüştürerek yine A1 hücresinde tamsayı olarak kalmasını sağladığı ve kuruşu da yanındaki hücreye attığını anlatır mısınız? Ben beceremedim. Ama mesela A1 hücresine yazılan kuruşlu rakamın tam sayısını ve küsuratını başka hücrelere taşıyabiliyor (mesela B1 ve C1 hücrelerine) ve bunları daha başka bir sütuna yazı olarak YTL ve YKR cinsinden aktartabiliyorum. Tabii ki forumdaki bilgilerden faydalanarak. Ama aynı hücre içinde hem tamsayıyı tutmasını hem de kuruşu yan hücreye göndermesini yapamadım. Yardımcı olursanız sevinirim. Kendi deneme dosyamı da gönderiyorum belki ifade de nakıslık olabilir. Ã?rnekle göstermiş olayım.
 
gönderdiğim dosyada herhangi bir hücreye rakamı yazın, nasıl çalıştığını göreceksiniz.

kodlar modülün içine değil, kullanılacak sayfanın içine yazılmalı. belki de o yüzden kullanamadınız.
 
Teşekkür ederim sayın Acemi. Þimdi haklı olarak ben de sizin yukarıda sorduğunuz soruyu soruyorum. İçerik değişmediği müddetçe şu sıfır kendiliğinden yazılmazsa iyi olurdu. Bunu nasıl yapacağız? Bir soru da Acemi beye; acaba şu an üzerinde çalıştığım bir sayfa da sadece istediğim hücrelere bu fonksiyonu nasıl uygulatabilirim. Yani formül tüm sayfada değil de sadece belirli hücrelerde çalışsın. Mümkünse yardımcı olabilir misiniz? Tabii ki bu soru tüm arkadaşlara sorulmuştur aynı zamanda.
 
Sn Alpen,
Ã?ncelikler ilginiz için teşekkür ederim.
Ancak benim yapmak istediğim bu değildi.
Ben A sütunundaki herhangi bir hücreye ya da başka bir sütundaki hücreye rakamı yazıp enter a bastığım zaman kendisi A1 e tam kısmını, yanındaki hücreye de kuruşlu kısmını yazdırmak istemiştim.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
xx = Target.Column
a = Target.Row - 1
If a <= 0 Then a = 1 Else
If Cells(a, xx + 1) = 0 Then 'bu kısımda da 2inci kolon seçilmiş
If Cells(a, xx) = 0 Then Exit Sub '1 kolon 0 ise çıkmış
Cells(a, xx + 1) = (100 * Cells(a, xx)) - (100 * Int(Cells(a, xx))) '2 kolona krş yazılmış
Cells(a, xx) = Int(Cells(a, xx)) '1 kolona ytl yazılmış ...
End If
End Sub

Burdaki kodlarla istediğimi yapıyorum. Fakat,
rakamı değiştirmek gerektiği zaman yani yeni tutarı yazdığım zaman çalışmıyor çünki sağdaki hücre dolu.
Yeni miktarı yadığımızda sağdaki hücreyi de değiştirebilmek istiyorum. Bunun kodlarını bi türlü bulamadım. Ancak hücreyi seçince değil, değiştirince çalışsın istiyorum.
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
xx = Target.Column
a = Target.Row - 1
If a <= 0 Then a = 1 Else
If Cells(a, xx + 1) = 0 Or Cells(a, xx) <> "" Then 'bu kısım değişti
If Cells(a, xx) = 0 Then Exit Sub '1 kolon 0 ise çıkmış
Cells(a, xx + 1) = (100 * Cells(a, xx)) - (100 * Int(Cells(a, xx))) Cells(a, xx) = Int(Cells(a, xx)) '1 kolona ytl yazılmış ...
End If
End Sub

Yukarıdaki kodu kullanın Or Cells(a, xx) <> "" bu kodu ilave ettim. Kolay gelsin
 
Bişey daha sorabilirmiyim?
A1 e rakammı yazıyoruz. A1 ve B1 e aktarıyor.
Sonra A2 ye rakamı yazıyoruz. A2 ve B2 ye aktarıyor.
FAkat A2 ye tıkladığımızda B1 i 0 yapıyor.
Acaba bunun için bişey yapabilirmiyiz?
 
Arkadaşlar bi daha sorsam etkisi olur mu acaba?
bu hücreyi seçince sıfır yazma sorununu halledebilir misiniz?

Kodların son hali burda:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
xx = Target.Column
a = Target.Row - 1
If a <= 0 Then a = 1 Else
If Cells(a, xx + 1) = 0 Or Cells(a, xx) <> "" Then
If Cells(a, xx) = 0 Then Exit Sub
Cells(a, xx + 1) = Int((100 * Cells(a, xx)) - (100 * Int(Cells(a, xx))))
Cells(a, xx) = Int(Cells(a, xx))
End If
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst