Kod İle Aynı Sayfada Veri Kaydetme

[ahmed_ummu]

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

 

[ahmed_ummu]

Dosya içinde açıklama yazıp tekrar veriyorum. linkini.

İndir VERİ TABANI1111

Dosyayı indir VERİ TABANI1111

dosya.co

 

[ahmed_ummu]

Ne istediğimi tam olarak anlatamadım herhalde.

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

 

[halit3]

Bu kodu bir dene

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.

 

[ahmed_ummu]

Bu kodu bir dene

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.

Çok teşekkür ederim Halit bey elinize sağlık.

 

[ahmed_ummu]

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.

 

[halit3]

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

 

[ahmed_ummu]

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

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:

 

[halit3]

kotda hata alınan yer sarı renkli olması gerekiyor orada mause ile son,sut ,i ,j, değişkenlerinin üzerine gel ne yazıyor.

 

[halit3]

Buraya eklediğiniz örnek dosyanızda kodlar çalışıyor.

 

[ahmed_ummu]

Buraya eklediğiniz örnek dosyanızda kodlar çalışıyor.

Bi daha bakıyım. Teşekkürler

 

[ahmed_ummu]

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.

 

[ahmed_ummu]

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

 

[ahmed_ummu]

Ş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]

Ş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

Bu sorun da düzeldi. Halit beye ve yardımı olan herkese çok çok teşekkür ederim.

 

[halit3]

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

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

 

[ahmed_ummu]

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

Anladım Teşekkürler Halit bey.

 

[ahmed_ummu]

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

 

[ÖmerFaruk]

Sheets("puantaj").Range("b8:ar948") Copy
Sheets("ekders giriş").Range("n54:bd994").PasteSpecial xlPasteValues

 

[ahmed_ummu]

Sheets("puantaj").Range("b8:ar948") Copy
Sheets("ekders giriş").Range("n54:bd994").PasteSpecial xlPasteValues

Ö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