DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
demişsiniz. Ancak çıkış bölümünü boş bıraktığınızda bir sonraki kaydı işlerken herhangi bir sorun ile karşılaşmadım.teknik' Alıntı:...yani örneğin çıkış bölümü boş bırakıldı bir sonraki kayıtta çıkış kısmına tarih veya veri girilirse aynı kayıtın karşısına yazsın şimdiki konumda bir önceki kayıtın karşısına yazıyor. boş satırları kontrol ederek takip ediyor. bunu düzeltilirse benim de çok işime gelecek ilgilenirseniz sevinirim.
Teşekkürler
Sayın bulsan, dilim döndüğünce izah etmeye çalışayım :bulsan' Alıntı:BİRDE BU TABLOYU YAPARKEN GİTTİÃİNİZ YOL HAKKINDA BENİ BİLGİLENDİREBİLİRSENİZ ÇOK SEVİNİRİM ÃİMDİDEN TEÃEKKÜRLER
Private Sub CommandButton1_Click()
Call denetle'kayıt yapılmadan önce denetle makrosu çalışacak(bknz:private sub denetle )
Dim i As Integer ' i değişkeni bi tamsayı olarak belirleniyor
For i = 1 To Worksheets.Count 'i değeri 1 den başlayıp sayfa sayısı kadar oluyor
If Sheets("GİRİÃ").[c6].Value = Worksheets(i).Name Then 'eğer c6 hücresindeki değer sayfa adlarından birine eşit ise;
Worksheets(i).Range("a65536").End(xlUp)(2, 1).Value = _
Sheets("GİRİÃ").Cells(3, 3).Value 'i değerine eşit olan sayfanın a sütununun en altından yukarı doğru çıkılıp bulunan hücrenin bir altındaki hücre değeri giriş sayfasındaki 3:3 kesişme yeri yani c3 değeri yazılacak.
Worksheets(i).Range("b65536").End(xlUp)(2, 1).Value = _
Sheets("GİRİÃ").Cells(4, 3).Value 'i değerine eşit olan sayfanın b sütununun en altından yukarı doğru çıkılıp bulunan hücrenin bir altındaki hücre değeri giriş sayfasındaki 4:3 kesişme yeri yani c4 değeri yazılacak.
Worksheets(i).Range("c65536").End(xlUp)(2, 1).Value = _
Sheets("GİRİÃ").Cells(5, 3).Value 'i değerine eşit olan sayfanın c sütununun en altından yukarı doğru çıkılıp bulunan hücrenin bir altındaki hücre değeri giriş sayfasındaki 5:3 kesişme yeri yani c5 değeri yazılacak.
Worksheets(i).Range("d65536").End(xlUp)(2, 1).Value = _
Sheets("GİRİÃ").Cells(6, 3).Value 'i değerine eşit olan sayfanın d sütununun en altından yukarı doğru çıkılıp bulunan hücrenin bir altındaki hücre değeri giriş sayfasındaki 6:3 kesişme yeri yani c6 değeri yazılacak.
Worksheets(i).Range("e65536").End(xlUp)(2, 1).Value = _
Sheets("GİRİÃ").Cells(7, 3).Value 'i değerine eşit olan sayfanın e sütununun en altından yukarı doğru çıkılıp bulunan hücrenin bir altındaki hücre değeri giriş sayfasındaki 7:3 kesişme yeri yani c7 değeri yazılacak.
Call devam ' devam nakrosu çalışacak ( bknz: private sub devam )
End If
Next i ' döngü sayfa sayısı sona erene kadar tekrarlanıyor
If Cells(3, 3).Value <> Empty Then ' eğer c3 boşsa ( giriş tarihi )
MsgBox "Geçerli Giriş Tarihi ile herhangi bir sayfaya kayıt yapılamadı" & _
vbNewLine & "Lütfen kontrol edip tekrar deneyiniz", vbInformation, "Hata Oluştu" ' ... şeklinde bir mesajla kullanıcıyı uyaracak
Exit Sub ' makrodan çık
End If ' koşul sonu
End Sub' makro sonu
Private Sub denetle()
' İsim ve plaka vs.. küçük harf yazıldıysa büyük harfe dönüştürüyor.
Sheets("GİRİÃ").[c4].Value = UCase(Sheets("GİRİÃ").[c4].Value)
Sheets("GİRİÃ").[c5].Value = UCase(Sheets("GİRİÃ").[c5].Value)
'Sheets("GİRİÃ").[c6].Value = UCase(Sheets("GİRİÃ").[c6].Value)
'Sheets("GİRİÃ").[c7].Value = UCase(Sheets("GİRİÃ").[c7].Value)
End Sub
Private Sub devam()
MsgBox "Kayıt işlenmiştir ", vbInformation, "Bilgi"
Sheets("GİRİÃ").[c3:c7].ClearContents 'Kayıt tamamlandıktan sonra bilgi mesajı geliyor ve daha önce yazılan bilgiler hücrelerden temizleniyor.
End Sub
Private Sub CommandButton1_Click()
Call denetle
Dim i As Integer
For i = 1 To Worksheets.Count
If Sheets("GİRİÃ").[c6].Value = Worksheets(i).Name Then
Worksheets(i).Range("a65536").End(xlUp)(2, 5).Value = _
Sheets("GİRİÃ").Cells(7, 3).Value
Worksheets(i).Range("a65536").End(xlUp)(2, 4).Value = _
Sheets("GİRİÃ").Cells(6, 3).Value
Worksheets(i).Range("a65536").End(xlUp)(2, 3).Value = _
Sheets("GİRİÃ").Cells(5, 3).Value
Worksheets(i).Range("a65536").End(xlUp)(2, 2).Value = _
Sheets("GİRİÃ").Cells(4, 3).Value
Worksheets(i).Range("a65536").End(xlUp)(2, 1).Value = _
Sheets("GİRİÃ").Cells(3, 3).Value
Call devam
End If
Next i
If Cells(3, 3).Value <> Empty Then
MsgBox "Geçerli Giriş Tarihi ile herhangi bir sayfaya kayıt yapılamadı" & _
vbNewLine & "Lütfen kontrol edip tekrar deneyiniz", vbInformation, "Hata Oluştu"
Exit Sub
End If
End Sub