• DİKKAT

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

Kod İle Aynı Sayfada Veri Kaydetme

ahmed_ummu

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
777
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Merhaba arkadaşlar.

İnşallah ne yapmak istediğimi anlatabilirim. Dosya linkini verdiğim dosya da "Ekders Giriş" sayfasında "Puantaja Ekle" butonuna basınca, Aynı sayfada bulunan tabloya 54. satırdan itibaren yazdırmak istiyorum.

Tablodaki gün isimlerini AH15 hücresindeki tarih başlangıcından alıyo hücre sayısı kadar gün isimlerini yazıyor. Verileri yazarken, AM15 hücresindeki tarihe kadar yazacak. Yani bu tarihlere göre 4 ile 31 günlerine yazacak.

Aralık ve Haziran ayları dışında tüm ayların hafta bütünlüğü bozulmuyor. Yani tüm haftalar Pazartesi, Salı, Çarşamba, Perşembe, Cuma, Cumartesi, Pazar günlerini kapsıyor.
Mesela Ekim ayının son günü Perşembe ise bir sonraki ayın Cuma, Cumartesi, Pazar yani ayın 1, 2, 3 ünü de alıyor, hafta bütünlüğü bozulamaması için. Diyelim ki ayın son iki günü Pazartesi ve Salı olursa bir sonraki aya kalıyor. yani haftanın yarıdan fazlası hangi aya aitse hafta bütünlüğü o ayda kalıyor.

Tabloya yazılacak veriler, p ve v sütunları ve 21 ve 27 satırlarda. Her öğretmen için veriler sadece birer hafta girildi. Ama tabloya yazılırken, ayın 4'ünden 31'ine kadar yazılacak. Butonların hemen altındaki tabloya yazılmayacak, sözünü etiğim tablo 54 satırdan başlıyor.

Tabloya yazarken, pazartesi gününe Verilerin alınacağı Pazartesi günündeki veri, Salı gününe, Salı günündeki veriler gelecek Ta ki ayın 31'ine kadar.

21. satırdaki veri yazıldıktan sonra 22. satırdaki veri hemen altına, öyle alt alta yazılacak. 21-27 satırlarda arasındaki veril girilmemiş satırlar yani boş satırlar yazılmayacak.

İnşallah anlatabilmişimdir. İşlemler Ekders Giriş sayfasında yapılacak. Yardımcı olursanız çok sevinirim.

İndir VERİ TABANI1111

Dosyayı indir VERİ TABANI1111
dosya.co
 
Ne istediğimi tam olarak anlatamadım herhalde.

Resmin üzerinde anlatmaya çalıştım. Yardımcı olursanız sevinirim.
 

Ekli dosyalar

  • Adsız.jpg
    Adsız.jpg
    511.5 KB · Görüntüleme: 10
Bu kodu bir dene
Kod: 
Private Sub CommandButton14_Click()

Sut = 16
son = Cells(Rows.Count, "n").End(xlUp).Row + 1
If son <= 54 Then son = 54
For i = 21 To 27
If WorksheetFunction.CountA(Range(Cells(i, 16), Cells(i, 22))) > 0 Then
Cells(son, "n").Value = Cells(12, "p").Value
Cells(son, "o").Value = Cells(13, "p").Value
Cells(son, "bb").Value = Cells(14, "p").Value
Cells(son, "bf").Value = Cells(i, "am").Value
For k = 1 To 7
For j = 16 To 22
Cells(son, Sut).Value = Cells(i, j).Value
Sut = Sut + 1
sat = sat + 1
sut2 = (Cells(15, "am").Value - Cells(15, "ah").Value) + 1
If sat = sut2 Then GoTo atla1
Next j
Next k
atla1:
sat = 0
Sut = 16
son = son + 1
End If
Next i
MsgBox "İşlem tamam"

End Sub

Not: Bir dosyada eğer makro çalıştıracaksanız hücreleri birleştirmeyiniz.
 
Son düzenleme:
halit3' Alıntı:
Bu kodu bir dene
Kod: 
Private Sub CommandButton14_Click()

Sut = 16
son = Cells(Rows.Count, "n").End(xlUp).Row + 1
If son <= 54 Then son = 54
For i = 21 To 27
If WorksheetFunction.CountA(Range(Cells(i, 16), Cells(i, 22))) > 0 Then
Cells(son, "n").Value = Cells(12, "p").Value
Cells(son, "o").Value = Cells(13, "p").Value
Cells(son, "bb").Value = Cells(14, "p").Value
Cells(son, "bf").Value = Cells(i, "am").Value
For k = 1 To 7
For j = 16 To 22
Cells(son, Sut).Value = Cells(i, j).Value
Sut = Sut + 1
sat = sat + 1
sut2 = (Cells(15, "am").Value - Cells(15, "ah").Value) + 1
If sat = sut2 Then GoTo atla1
Next j
Next k
atla1:
sat = 0
Sut = 16
son = son + 1
End If
Next i
MsgBox "İşlem tamam"

End Sub

Not: Bir dosyada eğer makro çalıştıracaksanız hücreleri birleştirmeyiniz.
Genişletmek için tıkla ...

Çok teşekkür ederim Halit bey elinize sağlık.
 
Halit bey resim görüntüsünü gönderdiğim gibi olabilir mi? Çerçeve içine aldığım p14 hücresindeki veriye göre döngü ile yapılabilinir mi?
p14 değeri HESAPLANMASIN ise o kişi için bir işlem yapmayıp diğer kişiye geçsin.
HESAPLANMASIN veya HESAPLANSIN bilgisi Sayfa1 sayfasının AN sütununda.
 

Ekli dosyalar

  • adsız11.jpg
    adsız11.jpg
    401.8 KB · Görüntüleme: 11
KOD

Kod: 
Private Sub CommandButton14_Click()

Sut = 16
son = Cells(Rows.Count, "n").End(xlUp).Row + 1
If son <= 54 Then son = 54
If Cells(15, "p").Value <> "HESAPLANSIN" Then GoTo atla2

For i = 21 To 27
If WorksheetFunction.CountA(Range(Cells(i, 16), Cells(i, 22))) > 0 Then
Cells(son, "n").Value = Cells(12, "p").Value
Cells(son, "o").Value = Cells(13, "p").Value
Cells(son, "bb").Value = Cells(14, "p").Value
Cells(son, "bf").Value = Cells(i, "am").Value
For k = 1 To 7
For j = 16 To 22
Cells(son, Sut).Value = Cells(i, j).Value
Sut = Sut + 1
sat = sat + 1
sut2 = (Cells(15, "am").Value - Cells(15, "ah").Value) + 1
If sat = sut2 Then GoTo atla1
Next j
Next k
atla1:
sat = 0
Sut = 16
son = son + 1
End If
Next i
MsgBox "İşlem tamam"
atla2:
End Sub
 
halit3' Alıntı:
KOD

Kod: 
Private Sub CommandButton14_Click()

Sut = 16
son = Cells(Rows.Count, "n").End(xlUp).Row + 1
If son <= 54 Then son = 54
If Cells(15, "p").Value <> "HESAPLANSIN" Then GoTo atla2

For i = 21 To 27
If WorksheetFunction.CountA(Range(Cells(i, 16), Cells(i, 22))) > 0 Then
Cells(son, "n").Value = Cells(12, "p").Value
Cells(son, "o").Value = Cells(13, "p").Value
Cells(son, "bb").Value = Cells(14, "p").Value
Cells(son, "bf").Value = Cells(i, "am").Value
For k = 1 To 7
For j = 16 To 22
Cells(son, Sut).Value = Cells(i, j).Value
Sut = Sut + 1
sat = sat + 1
sut2 = (Cells(15, "am").Value - Cells(15, "ah").Value) + 1
If sat = sut2 Then GoTo atla1
Next j
Next k
atla1:
sat = 0
Sut = 16
son = son + 1
End If
Next i
MsgBox "İşlem tamam"
atla2:
End Sub
Genişletmek için tıkla ...

Teşekkürler Halit bey.

SSut = 16
son = Cells(Rows.Count, "n").End(xlUp).Row + 1
If son <= 54 Then son = 54
If Cells(15, "p").Value <> "HESAPLANSIN" Then GoTo atla2

For i = 21 To 27
If WorksheetFunction.CountA(Range(Cells(i, 16), Cells(i, 22))) > 0 Then
Cells(son, "n").Value = Cells(12, "p").Value
Cells(son, "o").Value = Cells(13, "p").Value
Cells(son, "bb").Value = Cells(14, "p").Value
Cells(son, "bf").Value = Cells(i, "am").Value
For k = 1 To 7
For j = 16 To 22
Cells(son, Sut).Value = Cells(i, j).Value 'Bu satırda eklediğim resimdeki hatayı veriyor.
Sut = Sut + 1
sat = sat + 1
sut2 = (Cells(15, "am").Value - Cells(15, "ah").Value) + 1
If sat = sut2 Then GoTo atla1
Next j
Next k
atla1:
sat = 0
Sut = 16
son = son + 1
End If
Next i
MsgBox "İşlem tamam"
atla2:
 

Ekli dosyalar

  • UYARI.jpg
    UYARI.jpg
    16.1 KB · Görüntüleme: 3
kotda hata alınan yer sarı renkli olması gerekiyor orada mause ile son,sut ,i ,j, değişkenlerinin üzerine gel ne yazıyor.
 
Buraya eklediğiniz örnek dosyanızda kodlar çalışıyor.
 
Tamam Halit bey çalışıyor. HESAPLANSIN, HESAPLANMASIN şartına göre işlem yapsın dediğim mesajımda, döngü ile de yapılabilir mi yazmıştım.
Döngü başka şey için demiştim. Bu haliyle kişileri tek tek çağırıp verilerini kaydediyoruz. Döngü ile yapılabilir mi demekten maksadım, Butona bastığımızda kimin AN sütununda HESAPLANSIN değeri varsa en baştan başlasın en son kişiye kadar döngü ile işlemi yapsın kasdetmiştim. Dediğim gibi olabiliyorsa çok iyi olur ama bu haliyle de çok güzel işimi görüyor. Teşekkürler.
 
1. ve 2. mesajlarda verdiğiniz kodlarla hemen hemen tam istediğim gibi oldu Halit bey.

Yalnız aşağıdaki kod ile Ekders giriş sayfasındaki bc54:bd994 hücrelerdeki verileri, puantaj sayfasındaki aq8:ar949 hücrelerine aldırırken overflow hatası veriyor.

Sheets("puantaj").Range("aq8:ar949").Value = Sheets("ekders giriş").Range("bc54:bd994").Value

Bir de resimde gönderdiğim gibi en son satıra #YOK yazıyor
 

Ekli dosyalar

  • koplayama hatası.jpg
    koplayama hatası.jpg
    653.9 KB · Görüntüleme: 4
Şu an sorunsuz çalışıyor fakat AF8 colonundan, başlayacak, AO8 colonuna kadar boş olan colonları gizleyecek. Aşağıdaki kod ile kırmızı renki olan yeri seçip, hata veriyor.

Private Sub CommandButton3_Click()
Sheets("puantaj").Range("ae8").Select
For i = ActiveSheet.Range("af8").Column To ActiveSheet.Range("ao8").Column
If ActiveSheet.Cells(2, i + 1) <> "" Then ActiveSheet.Columns(i).Hidden = False
Next
End Sub
 
ahmed_ummu' Alıntı:
Şu an sorunsuz çalışıyor fakat AF8 colonundan, başlayacak, AO8 colonuna kadar boş olan colonları gizleyecek. Aşağıdaki kod ile kırmızı renki olan yeri seçip, hata veriyor.

Private Sub CommandButton3_Click()
Sheets("puantaj").Range("ae8").Select
For i = ActiveSheet.Range("af8").Column To ActiveSheet.Range("ao8").Column
If ActiveSheet.Cells(2, i + 1) <> "" Then ActiveSheet.Columns(i).Hidden = False
Next
End Sub
Genişletmek için tıkla ...

Bu sorun da düzeldi. Halit beye ve yardımı olan herkese çok çok teşekkür ederim.
 
ahmed_ummu' Alıntı:
1. ve 2. mesajlarda verdiğiniz kodlarla hemen hemen tam istediğim gibi oldu Halit bey.

Yalnız aşağıdaki kod ile Ekders giriş sayfasındaki bc54:bd994 hücrelerdeki verileri, puantaj sayfasındaki aq8:ar949 hücrelerine aldırırken overflow hatası veriyor.

Sheets("puantaj").Range("aq8:ar949").Value = Sheets("ekders giriş").Range("bc54:bd994").Value

Bir de resimde gönderdiğim gibi en son satıra #YOK yazıyor
Genişletmek için tıkla ...

puantaş sayfası 942 satır ekders giriş sayfası 941 satır
olduğundan bu işlemde son satırı #YOK hatası verecektir.

949 - 948 olacak
veya
994 - 995 olacak
 
İyi akşamlar arkadaşlar.

Sheets("puantaj").Range("b8:ar948").Value = Sheets("ekders giriş").Range("n54:bd994").Value

Ekders giriş sayfasındaki n54:bd994 hücrelerindeki verileri, puantaj sayfasındaki ba8:ar949 hücrelere aldırmak istiyorum ama overflow hatası veriyor.
 
Sheets("puantaj").Range("b8:ar948") Copy
Sheets("ekders giriş").Range("n54:bd994").PasteSpecial xlPasteValues
 
ÖmerFaruk' Alıntı:
Sheets("puantaj").Range("b8:ar948") Copy
Sheets("ekders giriş").Range("n54:bd994").PasteSpecial xlPasteValues
Genişletmek için tıkla ...

Ömer Faruk bey teşekkürler.

Kırmızı renkli satırda Syntax error olarak hata veriyor.

Sheets("puantaj").Range("b8:ar948") Copy
Sheets("ekders giriş").Range("n54:bd994").PasteSpecial xlPasteValues
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst