• DİKKAT

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

Hücre değerine göre döngü oluşturup kaydetme

S

s.savas

Katılım
12 Ocak 2009
Mesajlar
838
Excel Vers. ve Dili
2003
İyi geceler arkadaşlar.
Aşağıdaki kodu revize etmek istiyorum.
Sabit isimli sekmenin F1 hücresinin aldığı değere göre bir döngü oluşturmak istiyorum. Şöyleki;
Sabit isimli sekmenin F1 hücresi 2011 YILI BÜTÇE TAKİBİ ise cmdKAYDET ile Onay Defteri 2011 sekmesine, F1 hücresi 2012 YILI BÜTÇE TAKİBİ ise Onay Defteri 2012 sekmesine, F1 hücresi 2013 YILI BÜTÇE TAKİBİ ise Onay Defteri 2013 sekmesine, F1 hücresi 2014 YILI BÜTÇE TAKİBİ ise Onay Defteri 2014 sekmesine, F1 hücresi 2015 YILI BÜTÇE TAKİBİ ise Onay Defteri 2015 sekmesine, kaydetmesini istiyorum.

Kod: 
Private Sub cmdKAYDET_Click()
Dim satır As Long, k As Byte

satır = Range("A65536").End(3).Row + 1
If ComboBox1.Value = "" Or ComboBox2.Value = "" Or ComboBox3.Value = "" Or TextBox2.Value = "" Or TextBox3.Value = "" Then
MsgBox "Eksik Bilgi Girdiniz", vbMsgBoxRtlReading + vbCritical, "s.s."
Exit Sub
End If

TextBox1 = FormatDateTime(Now, vbShortDate)
Cells(satır, "B").Value = TextBox1.Value 'Kayıt Tarihi
Cells(satır, "C").Value = TextBox2.Value 'Mal veya Hizmetin Adı
Cells(satır, "D").Value = ComboBox1.Value 'Bütçe / Hesap Adı
Cells(satır, "E").Value = ComboBox2.Value 'Alım Yöntemi
Cells(satır, "L").Value = ComboBox3.Value 'Onayı Alanın Adı-Soyadı
Cells(satır, "G").Value = TextBox3.Value 'Yaklaşık Maliyet
Cells(satır, "G").NumberFormat = "#,##0.00 TL" '#.##0,00 TL
Cells(satır, "A").Value = TextBox4.Value 'Onay No
Cells(satır, "F").Value = TextBox5.Value 'Kalan Ödenek Tutarı
Cells(satır, "F").NumberFormat = "#,##0.00 TL"
Cells(satır, "H").Value = TextBox6.Value 'Artan Bütçe
Cells(satır, "H").NumberFormat = "#,##0.00 TL"
Cells(satır, "j").Value = TextBox7.Value 'Gerçekleşme Tarihi
Cells(satır, "K").Value = TextBox8.Value 'Açıklama

For k = 1 To 14
Cells(satır, k).Borders.LineStyle = 1
Next
' Koşullar
Select Case ComboBox2.Value
Case "m.19"
Cells(satır, "M").Value = "1"
Cells(satır, "M").HorizontalAlignment = xlCenter
Case "m.21-b"
Cells(satır, "M").Value = "1"
Cells(satır, "M").HorizontalAlignment = xlCenter
Case "m.22-a"
Cells(satır, "M").Value = "1"
Cells(satır, "M").HorizontalAlignment = xlCenter
Case "m.22-f"
Cells(satır, "M").Value = "1"
Cells(satır, "M").HorizontalAlignment = xlCenter
Case "m.22-d"
Cells(satır, "N").Value = "1"
Cells(satır, "N").HorizontalAlignment = xlCenter
Case "m.21-f"
Cells(satır, "N").Value = "1"
Cells(satır, "N").HorizontalAlignment = xlCenter
Case "Çerçeve"
Cells(satır, "M").Value = "1"
Cells(satır, "M").HorizontalAlignment = xlCenter
Case "D.M.O"
Cells(satır, "M").Value = "1"
Cells(satır, "M").HorizontalAlignment = xlCenter
'Case Else
'koşullar oluşmazsa
End Select

TextBox1.Value = Empty
TextBox2.Value = Empty
TextBox3.Value = Empty
TextBox4.Value = Empty
TextBox5.Value = Empty
TextBox6.Value = Empty
TextBox7.Value = Empty
TextBox8.Value = Empty

ComboBox1.Value = Empty
ComboBox2.Value = Empty
ComboBox3.Value = Empty
Unload Me
frmONAY.Show 0
End Sub
 

Ekli dosyalar

Selamlar,

Aşağıdaki kodu denermisiniz.

Kod: 
Private Sub cmdKAYDET_Click()
Dim satır As Long, k As Byte
 
[COLOR=red]With Sheets("Onay Defteri " & Left(Sheets("SABİT").Range("F1"), 4))
[/COLOR]    satır = .Range("A65536").End(3).Row + 1
    If ComboBox1.Value = "" Or ComboBox2.Value = "" Or ComboBox3.Value = "" Or TextBox2.Value = "" Or TextBox3.Value = "" Then
    MsgBox "Eksik Bilgi Girdiniz", vbMsgBoxRtlReading + vbCritical, "s.s."
    Exit Sub
    End If
    
    TextBox1 = FormatDateTime(Now, vbShortDate)
    .Cells(satır, "B").Value = TextBox1.Value 'Kayıt Tarihi
    .Cells(satır, "C").Value = TextBox2.Value 'Mal veya Hizmetin Adı
    .Cells(satır, "D").Value = ComboBox1.Value 'Bütçe / Hesap Adı
    .Cells(satır, "E").Value = ComboBox2.Value 'Alım Yöntemi
    .Cells(satır, "L").Value = ComboBox3.Value 'Onayı Alanın Adı-Soyadı
    .Cells(satır, "G").Value = TextBox3.Value 'Yaklaşık Maliyet
    .Cells(satır, "G").NumberFormat = "#,##0.00 TL" '#.##0,00 TL
    .Cells(satır, "A").Value = TextBox4.Value 'Onay No
    .Cells(satır, "F").Value = TextBox5.Value 'Kalan Ödenek Tutarı
    .Cells(satır, "F").NumberFormat = "#,##0.00 TL"
    .Cells(satır, "H").Value = TextBox6.Value 'Artan Bütçe
    .Cells(satır, "H").NumberFormat = "#,##0.00 TL"
    .Cells(satır, "j").Value = TextBox7.Value 'Gerçekleşme Tarihi
    .Cells(satır, "K").Value = TextBox8.Value 'Açıklama
    
    For k = 1 To 14
    .Cells(satır, k).Borders.LineStyle = 1
    Next
    ' Koşullar
    Select Case ComboBox2.Value
    Case "m.19"
    .Cells(satır, "M").Value = "1"
    .Cells(satır, "M").HorizontalAlignment = xlCenter
    Case "m.21-b"
    .Cells(satır, "M").Value = "1"
    .Cells(satır, "M").HorizontalAlignment = xlCenter
    Case "m.22-a"
    .Cells(satır, "M").Value = "1"
    .Cells(satır, "M").HorizontalAlignment = xlCenter
    Case "m.22-f"
    .Cells(satır, "M").Value = "1"
    .Cells(satır, "M").HorizontalAlignment = xlCenter
    Case "m.22-d"
    .Cells(satır, "N").Value = "1"
    .Cells(satır, "N").HorizontalAlignment = xlCenter
    Case "m.21-f"
    .Cells(satır, "N").Value = "1"
    .Cells(satır, "N").HorizontalAlignment = xlCenter
    Case "Çerçeve"
    .Cells(satır, "M").Value = "1"
    .Cells(satır, "M").HorizontalAlignment = xlCenter
    Case "D.M.O"
    .Cells(satır, "M").Value = "1"
    .Cells(satır, "M").HorizontalAlignment = xlCenter
    'Case Else
    'koşullar oluşmazsa
    End Select
    
    TextBox1.Value = Empty
    TextBox2.Value = Empty
    TextBox3.Value = Empty
    TextBox4.Value = Empty
    TextBox5.Value = Empty
    TextBox6.Value = Empty
    TextBox7.Value = Empty
    TextBox8.Value = Empty
    
    ComboBox1.Value = Empty
    ComboBox2.Value = Empty
    ComboBox3.Value = Empty
    Unload Me
    frmONAY.Show 0
[COLOR=red]End With
[/COLOR]End Sub
 
Korhan hocam teşekkür ederim ilginize.
Konuyla alakalı olarak aşağıdaki kod içinde bir döngü oluşturabilirmiyiz.

Sabit isimli sekmenin F1 hücresi 2011 YILI BÜTÇE TAKİBİ ise ComboBox1
2011_BÜTÇESİ isimli sekmeden, 2012 YILI BÜTÇE TAKİBİ ise 2012_BÜTÇESİ isimli sekmeden, 2013 YILI BÜTÇE TAKİBİ ise 2013_BÜTÇESİ isimli sekmeden,2014 YILI BÜTÇE TAKİBİ ise 2014_BÜTÇESİ isimli sekmeden, 2015 YILI BÜTÇE TAKİBİ ise 2015_BÜTÇESİ isimli sekmeden kalan ödenek tutarını bulsun.

Kod: 
Private Sub ComboBox1_Change()
Dim Bul As Range
For Each Bul In Range("2011_BÜTÇESİ!B2:G" & Range("2011_BÜTÇESİ!B65536").End(3).Row)
   If Bul.Value = ComboBox1.Value Then
      TextBox5.Value = Bul.Offset(0, 11).Value
      TextBox5.Text = FormatCurrency(TextBox5.Text, 2)
   End If
Next Bul
End Sub
 
Selamlar,

Aşağıdaki şekilde kullanabilirsiniz.

Kod: 
Private Sub ComboBox1_Change()
    Dim Bul As Range, Sayfa As String
    Sayfa = Left(Sheets("Sabit").Range("F1"), 4)
    For Each Bul In Sheets(Sayfa & "_BÜTÇESİ").Range("B2:G" & Sheets(Sayfa & "_BÜTÇESİ").Range("B65536").End(3).Row)
       If Bul.Value = ComboBox1.Value Then
          TextBox5.Value = Bul.Offset(0, 11).Value
          TextBox5.Text = FormatCurrency(TextBox5.Text, 2)
       End If
    Next Bul
End Sub
 
Teşekkür ederim Korhan hocam.
Bütçe sekmesinin M sütununda bulunan kalan ödenek tutarlarında virgülden sonra rakam olması durumunda tutar sanki binle çarpılmış gibi gösteriliyor. Kuruş hanesi sıfır ise sonucu normal gösteriyor.
Örnekler:
Bütçe Kodu: Gösterilen Tutar Gerçek Tutar
255.01 = 477.261,00 47.261,10
255.07 = 17.262,00 1.726,20
255.10 = 577.701,00 57.710,10
740.01 = 5.058.324,00 505.832,40
740.02 = 165.244,00 16.524,40
740.105 = 11.502,00 1.150,20
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst