Toplam 4 sonuçtan 1 ile 4 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.018

    İ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
    250
    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

    Ofis Versiyon: Office 2007 / İşletim Sistemi: Microsoft Windows 7 Ultimate
    +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 (23.01.2018 Saat 12:12 ) değiştirilmiştir.

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

  4. #4
    Kıdemli Üye
    Üyelik tarihi
    Jun 2010
    Nereden
    ankara
    Mesajlar
    250
    Teşekkürler iyi çalışmalar

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
  •