Sayfadaki bilgileri farklı kaydedip, sonra kullanmak

[baybay]

Sayfadaki bilgileri, sayfa üzerinde farklı kaydetmek

veri - doğrulama ile GENEL sayfasına bir açılır menü yaptım. ben köy ismi seçerek, GELİR ve GİDER bilgilerini girdiğimde GENEL TOPLAM lar elde ediyorum. böylece her köy için sıra ile bilgileri giriyorum.

Benim istediğim, işlemi bitmiş (bilgi girişi yapılmış) köy ismine açılır menüden tekrar döndüğümde yazdığım bütün bilgileri aynı bulmak, yani bütün köyleri farklı kaydetmek.
böyle bir imkan var mıdır.
Yardımlarınız için şimdiden teşekkürler...

 

[baybay]

Benim için önemli bir konu, yardım edecek arkadaşları bekliyorum.

 

[Ferhat Pazarçevirdi]

Merhabalar

Ekteki dosyayı inceleyiniz. Veri girişinizden sonra, Kaydet tuşuna basarsanız, veriler kaydedilir. Tekrar açılır listeden çağırdığınızda da kaydettiğiniz şekli ile yüklenir.

Ben örnek birkaç veri ilave ettim. Siz bunları gerçekleri ile değiştirip kaydet dediğinizde gerçek veriler kaydedilir.

 

[baybay]

Teşekkürler yardımlarınız için;

 

[baybay]

Çok soru sorduğum için özür dileyerek 2 şey daha öğrenmek istiyorum.

1) Kaydet butonu olmadan otomatik kaydetme işlemi uygulanabilir mi?

2) Köy isimlerinin En altına GENEL TOPLAM yazısı eklersem, Genel toplam'a gelinde üstündeki bütün köy bilgilerinin toplamlarıını kutucukların içine yerleştirse bunun için nasıl bir kod yazılması gerekiyor.

 

[Ferhat Pazarçevirdi]

1) Kaydet butonu olmadan otomatik kaydetme işlemi uygulanabilir mi?

Varolan Worksheet_Change kodunuzu şu şekilde değiştiriniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim GelirKalemi, Gider1Kalemi, Gider2Kalemi
Dim y As Integer
If Not Intersect(Target, Cells(4, "A")) Is Nothing Then
   Application.EnableEvents = False
   Range("F9:F21").ClearContents
   Range("L9:L27").ClearContents
   Range("R9:R22").ClearContents
   For i = 38 To Cells(65536, 4).End(xlUp).Row
       If Cells(i, "D") = Cells(4, "A") Then
          y = 8
          For Each GelirKalemi In Split(Cells(i, "H"), ";")
              y = y + 1
              Cells(y, "F") = GelirKalemi
          Next
          y = 8
          For Each Gider1Kalemi In Split(Cells(i, "I"), ";")
              y = y + 1
              Cells(y, "L") = Gider1Kalemi
          Next
          y = 8
          For Each Gider2Kalemi In Split(Cells(i, "J"), ";")
              y = y + 1
              Cells(y, "R") = Gider2Kalemi
          Next
       End If
   Next i
   Application.EnableEvents = True
Else
   If Not Intersect(Target, Range("F9:F21,L9:L27,R9:R22")) Is Nothing Then
      Call Kaydet
      Application.EnableEvents = True
   End If
End If
   Application.EnableEvents = True
End Sub

Diğer sorunuza gelince;

2) Köy isimlerinin En altına GENEL TOPLAM yazısı eklersem, Genel toplam'a gelinde üstündeki bütün köy bilgilerinin toplamlarıını kutucukların içine yerleştirse bunun için nasıl bir kod yazılması gerekiyor.

Anlamadım. Nereye ne yazılması gerekiyor?Hücre isimleri ile belirtiniz.

 

[baybay]

Birçok üyeli bir forumda sadece birkaç kişiye zaman ayırmak diğer soru soran arkadaşlara haksızlık olur tabiki; onun için tekrar teşekkürler.

d47 hücresine GENEL TOPLAM yazdığımda, veri- doğrulama ile tekrar düzenlediğimde yukarıda ki açılır menüde köy isimlerinin altında GENEL TOPLAM ifadesi çıkacaktır.

Sorum şu, Gelir ve Gider bilgileri köy isimleri değiştikçe kaydedilen biçimde değişiyor. GENEL TOPLAM 'a gelince üstündeki bütün köy bilgilerini (toplamlarını) yine gelir ve gider kutucuklarına toplam olarak yansıtabilir mi?

 

[baybay]

Daha önce köyler ile ilgili Gelir ve Gider bilgilerini kutucuklara yazdığımızda, her köy için otomatik olarak kaydetme işini yapmasını sağlamıştık.

D108 hücresine GENEL TOPLAM ekledim. Son olarak yardımınızı beklediğim konu şudur:
A4 hücresindeki Açılır menüden köyler ile ilgili gelir ve gider olarak, bilgi girişlerini yapıyorum. Açılır menünün en altında olacak GENEL TOPLAM 'a geldiğimde üstündeki tüm köyler ile ilgili girilen bilgilerin toplamlarını yine aynı kutucuklarda göstermesini istiyorum.

 

[Ferhat Pazarçevirdi]

Kodlar biraz uzun oldu. Muhtemelen kısaltılabilir ama kullanımda çok büyük bir fark hissedeceğinizi sanmıyorum.

Ekteki dosyayı inceleyiniz.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim GelirKalemi, Gider1Kalemi, Gider2Kalemi
Dim Gelir(), Gider1(), Gider2()
Dim koy As Integer, i%, j%, k%
Dim y As Integer, Toplam As Long, x As Integer
If Not Intersect(Target, Cells(4, "A")) Is Nothing Then
   Application.EnableEvents = False
   Range("F9:F21").ClearContents
   Range("L9:L27").ClearContents
   Range("R9:R22").ClearContents
   If Target = "GENEL BÜTÇE" Then
'---->GELİRLER
      koy = Cells(65536, 4).End(xlUp).Row - 38
      ReDim Gelir(1 To koy, 1 To 13)
      For i = 38 To Cells(65536, 4).End(xlUp).Row
          y = y + 1
          For Each GelirKalemi In Split(Cells(i, "H"), ";")
              x = x + 1
              Gelir(y, x) = GelirKalemi
          Next
          x = 0
      Next i
      For i = 9 To 21
          j = j + 1
              For k = 1 To UBound(Gelir)
                  If IsEmpty(Gelir(k, j)) = True Or IsNumeric(Gelir(k, j)) = False Then Gelir(k, j) = 0
                  Toplam = Toplam + Gelir(k, j)
              Next k
          Cells(i, "F") = Toplam
          Toplam = 0
      Next i
'---->GİDER1
      x = 0: y = 0: j = 0
      ReDim Gider1(1 To koy, 1 To 19)
      For i = 38 To Cells(65536, 4).End(xlUp).Row
          y = y + 1
          For Each Gider1Kalemi In Split(Cells(i, "I"), ";")
              x = x + 1
              Gider1(y, x) = Gider1Kalemi
          Next
          x = 0
      Next i
      For i = 9 To 27
          j = j + 1
              For k = 1 To UBound(Gider1)
                  If IsEmpty(Gider1(k, j)) = True Or IsNumeric(Gider1(k, j)) = False Then Gider1(k, j) = 0
                  Toplam = Toplam + Gider1(k, j)
              Next k
          Cells(i, "L") = Toplam
          Toplam = 0
      Next i
'---->GİDER2
      x = 0: y = 0: j = 0
      ReDim Gider2(1 To koy, 1 To 14)
      For i = 38 To Cells(65536, 4).End(xlUp).Row
          y = y + 1
          For Each Gider2Kalemi In Split(Cells(i, "J"), ";")
              x = x + 1
              Gider2(y, x) = Gider2Kalemi
          Next
          x = 0
      Next i
      For i = 9 To 22
          j = j + 1
              For k = 1 To UBound(Gider2)
                  If IsEmpty(Gider2(k, j)) = True Or IsNumeric(Gider2(k, j)) = False Then Gider2(k, j) = 0
                  Toplam = Toplam + Gider2(k, j)
              Next k
          Cells(i, "R") = Toplam
          Toplam = 0
      Next i
  
   Else
      For i = 38 To Cells(65536, 4).End(xlUp).Row
          If Cells(i, "D") = Cells(4, "A") Then
             y = 8
             For Each GelirKalemi In Split(Cells(i, "H"), ";")
                 y = y + 1
                 Cells(y, "F") = GelirKalemi
             Next
             y = 8
             For Each Gider1Kalemi In Split(Cells(i, "I"), ";")
                 y = y + 1
                 Cells(y, "L") = Gider1Kalemi
             Next
             y = 8
             For Each Gider2Kalemi In Split(Cells(i, "J"), ";")
                 y = y + 1
                 Cells(y, "R") = Gider2Kalemi
             Next
          End If
      Next i
      Application.EnableEvents = True
   End If
Else
   If Not Intersect(Target, Range("F9:F21,L9:L27,R9:R22")) Is Nothing Then
      Call Kaydet
      Application.EnableEvents = True
   End If
End If
   Application.EnableEvents = True
End Sub