Hey there!

It looks like you're enjoying Hesaptablosu - Akademik Excel Forumu but haven't created an account yet. Why not take a minute to register for your own free account now? As a member you get free access to all of our forums and posts plus the ability to post your own messages, communicate directly with other members and much more. Register now!

Already a member? Login at the top of this page to stop seeing this message.

Toplam 3 sonuçtan 1 ile 3 arasındakiler gösteriliyor.

Konu: İnputBox ile kuruş ekle

  1. #1
    Kıdemli Üye
    Üyelik tarihi
    Jun 2010
    Nereden
    Erbaa
    Versiyon
    2010 TR
    Mesajlar
    1.010

    İnputBox ile kuruş ekle

    Office Ver.: bilinmiyor
    Windows Ver.: Windows 10 Enterprise 64 bit
    + A B C D E F G H I
    1 SNO ADI VE SOYADI SİGORTA İŞSİZLİK TAHAKKUK TUTARI SSK KESİNTİ MATRAHI İŞVEREN İŞÇİ
    2 1 Mehmet-1 396,07 18,00 2.427,20 2.031,13 250,00 250,01
    3 2 Mehmet-2 289,30 18,00 2.427,20 2.031,13 250,00 250,01
    4 3 Mehmet-3 396,07 18,00 2.427,20 2.031,13 250,00 250,01
    5 4 Mehmet-4 289,30 18,00 2.427,20 2.031,13 250,00 250,01
    6 5 Mehmet-5 396,07 18,00 2.427,20 2.031,13 250,00 250,00
    7 6 Mehmet-6 289,30 18,00 2.427,20 2.031,13 250,00 250,00
    8 7 Mehmet-7 396,07 18,00 2.427,20 2.031,13 250,00 250,00
    9 8 Mehmet-8 289,30 18,00 2.427,20 2.031,13 250,00 250,00
    10 9 Mehmet-9 396,07 18,00 2.427,20 2.031,13 250,00 250,00
    11 10 Mehmet-10 289,30 18,00 2.427,20 2.031,13 250,00 250,00
    12
    13
    Sayfa İsmi: LİSTE (Sayfa2)
    XLtoHTML v1.2 / OfficeTürkiye - 2014©

    Mrb Excel Dostları,
    Ordan burdan derlediğim aşağıdaki makro ile yukarıda yer alan G sütunundaki istediğim sayıdaki değerlerin üzerine Inputbox ile girdiğim kuruşu ekleyerek H sütununda yeni bir değerler elde etmek istiyorum.
    Benim makroda örneğin ilk dört kişiye 0,01 kuruş ekleyebiliyorum. Ancak diğerleri tabloda olduğu gibi ayni kalmalı.
    Benim makro onlara yani geri kalan 6 kişiyi hiç eklemiyor onlar H sütunundaki gibi 250,00 olmalı.
    Üstatların katkılarını bekliyorum.

    Sub kurus_ekle2()
    Dim s1 As Worksheet
    Dim son As Long, i As Long, a As Long
    Set s1 = Sheets("LİSTE")
    Range("H2:H300").ClearContents
    d = InputBox("Lütfen kişilere eklenecek kuruşu 0,01 formatında giriniz.", "U Y A R I")
    If d = "" Then
    MsgBox "Boş bırakmayın.", vbCritical, "H A T A"
    Exit Sub
    End If
    son = s1.Range("C" & Rows.Count).End(3).Row
    s1.Select
    k = InputBox("kaç kişiye kuruş eklenecek ?", "B İ L G İ")
    For i = 2 To (k + 1)
    If s1.Cells(i, 2).Value > 0 Then
    Cells(i, 8).Value = Cells(i, 7).Value + d

    End If
    Next i
    s1.Select
    Range("A2").Select
    End Sub
    Konu behcet tarafından (07.01.2018 Saat 12:13 ) değiştirilmiştir.

  2. #2
    Kıdemli Üye
    Üyelik tarihi
    Jun 2010
    Nereden
    ankara
    Mesajlar
    248
    kod:

    Kod:
    Sub kurus_ekle2()
    Dim s1 As Worksheet
    Dim son As Long, i As Long, a As Long
    Set s1 = Sheets("LİSTE")
    Range("H2:H300").ClearContents
    d = InputBox("Lütfen kişilere eklenecek kuruşu 0,01 formatında giriniz.", "U Y A R I")
    If d = "" Then
    MsgBox "Boş bırakmayın.", vbCritical, "H A T A"
    Exit Sub
    End If
    son = s1.Range("C" & Rows.Count).End(3).Row
    s1.Select
    k = InputBox("kaç kişiye kuruş eklenecek ?", "B İ L G İ")
    For i = 2 To son
    If s1.Cells(i, 2).Value > 0 Then
    If k + 2 <= i Then
    Cells(i, 8).Value = Cells(i, 7).Value
    Else
    Cells(i, 8).Value = Cells(i, 7).Value + d
    End If
    End If
    Next i
    s1.Select
    Range("A2").Select
    End Sub
    Gönderen XL Ver.: Office 2003 / OS Ver.: Microsoft Windows XP Professional
    +ABCDEFGH
    1SNOADI VE SOYADISİGORTAİŞSİZLİKTAHAKKUK TUTARISSK KESİNTİ MATRAHIİŞVERENİŞÇİ
    21Mehmet-1396,07182427,22031,13250,00250,01
    32Mehmet-2289,3182427,22031,13250,00250,01
    43Mehmet-3396,07182427,22031,13250,00250,01
    54Mehmet-4289,3182427,22031,13250,00250,01
    65Mehmet-5396,07182427,22031,13250,00250,01
    76Mehmet-6289,3182427,22031,13250,00250,01
    87Mehmet-7396,07182427,22031,13250,00250,00
    98Mehmet-8289,3182427,22031,13250,00250,00
    109Mehmet-9396,07182427,22031,13250,00250,00
    1110Mehmet-10289,3182427,22031,13250,00250,00
    Sayfa İsmi: (LİSTE)- Kod Sayfası: (Sayfa3) - Hücre Aralığı : ($A$1:$H$11)
    Konu halit3 tarafından (21.01.2018 Saat 21:39 ) değiştirilmiştir.

  3. #3
    Kıdemli Üye
    Üyelik tarihi
    Jun 2010
    Nereden
    Erbaa
    Versiyon
    2010 TR
    Mesajlar
    1.010
    Mrb Üstadım,
    Çok teşekkür ederim tam istediğim gibi. İmdada yetiştiniz.
    Sağ olun, sağlıcakla kalın.

Konu Bilgisi

Users Browsing this Thread

Şu anda 1 üyemiz bu konuya göz atıyor. (0 kayıtlı üye ve 1 misafir.)

Yetkileriniz

  • Konu Acma Yetkiniz Yok
  • Cevap Yazma Yetkiniz Yok
  • Eklenti Yükleme Yetkiniz Yok
  • Mesajınızı Değiştirme Yetkiniz Yok
  •