• DİKKAT

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

Taşıt görev emri formu

Katılım
1 Kasım 2012
Mesajlar
275
Excel Vers. ve Dili
Microsoft Office 2013 Türkçe
Arkadaşlar ekteki dosyamda 4 tane sayfam var. görev emri sayfasında girişleri tamamladığımda aktar butonu ile kayıt defterine aktarılıyor. lakin ben istiyorum ki bu defterdeki günlerde göreve çıkan personelin puantaj sayfasında da x işareti koysun. yani örneğin sefa buran isimli personel 14 ocak 2015 tarihinde göreve çıkmışsa bunu aktar butonu ile kayıt defterine atalım, ve aynı zamanda puantaj sayfasında da sefa buran için ocak ayının 15. gününe x işareti koyalım. bu mümkün müdür?

DOSYAM: http://s3.dosya.tc/server29/ebyDiW/ta__tg_revemri.rar.html
 
Merhaba,
Kodu uygulayınız.
Sub aktar()
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim son_satir As Long
Dim x As Long

Set s1 = Sheets("Görevemri")
Set s2 = Sheets("Kayıt Defteri")
son_satir = s2.Cells(65536, 1).End(3).Row + 1
s2.Cells(son_satir, "a") = s1.Range("C6") 'sıra No
s2.Cells(son_satir, "b") = s1.Range("f6") 'tarih
s2.Cells(son_satir, "c") = s1.Range("A23") 'talep eden personel
s2.Cells(son_satir, "d") = s1.Range("B14") '1. Görevli
s2.Cells(son_satir, "e") = s1.Range("B15") '2. Görevli
s2.Cells(son_satir, "f") = s1.Range("B16") '3. Görevli
s2.Cells(son_satir, "g") = s1.Range("B17") '4. Görevli
s2.Cells(son_satir, "h") = s1.Range("B18") '5. Görevli
s2.Cells(son_satir, "i") = s1.Range("B19") '6. Görevli
s2.Cells(son_satir, "j") = s1.Range("F18") 'şoför
s2.Cells(son_satir, "k") = s1.Range("F16") 'görev yeri
s2.Cells(son_satir, "l") = s1.Range("F17") 'açıklama
s2.Cells(son_satir, "m") = s1.Range("E11") 'araç

'Sayı: c6 tarih g6 1. görevli b14 2. görevli b15 3. görevli b16 4. görevli b17 5. görevli b18 6. görevli b19 ünvanları d aracın markası e11 plakası f11 görev yeri f16 görev açıklaması f17 şoför f18 ünvan f19 talep eden a23 unvan b23

a = Month(Range("F6"))
b = Day(Range("F6"))
süt = a * 32 - 30 + b
For i = 14 To 19
If Cells(i, 2) = "" Then GoTo 10
sat = WorksheetFunction.Match(Cells(i, 2), Sheets("Puantaj").Range("A3:A21"), 0) + 2
Sheets("Puantaj").Cells(sat, süt) = "x"
10
Next
sat = WorksheetFunction.Match(Range("F18"), Sheets("Puantaj").Range("A3:A21"), 0) + 2
Sheets("Puantaj").Cells(sat, süt) = "x"




MsgBox ("Taşıt Görev Emri Hazırlanmış ve Kaydedilmiştir."), vbInformation, "İdari ve Mali İşler, Sefa BURAN"
s1.Range("b1").Interior.ColorIndex = 19





End Sub
 
Ben İlçe tarım müdürlüğünde mutemet olarak çalışıyorum, kendime 2 yıldan beri mutemetlikle ilgili formları yapıyorum, hepsini access le yaptım, içindekileri sayıyorum, 1-Personel kayıt resimli şekilde, 2- İzin kayıt (bütün izinler, yıllık, Rapor, ölüm, doğum vs.. 3-Görev kağıdı, aylık rapor , yıllık rapor, bu kayıtlardan seyyar görev bordrosu hazır oluyor, yurtiçi geçici görev bordroları hazır oluyor. vs. 4- Özel hizmet puantayı, Özel hizmet bordrosu, Özel hizmet banka ödeme, uf uf hepsini yazmam çok zaman alacak, bir ara buraya eklerim inşallah. www.akdyazilim.com
 
Ben İlçe tarım müdürlüğünde mutemet olarak çalışıyorum, kendime 2 yıldan beri mutemetlikle ilgili formları yapıyorum, hepsini access le yaptım, içindekileri sayıyorum, 1-Personel kayıt resimli şekilde, 2- İzin kayıt (bütün izinler, yıllık, Rapor, ölüm, doğum vs.. 3-Görev kağıdı, aylık rapor , yıllık rapor, bu kayıtlardan seyyar görev bordrosu hazır oluyor, yurtiçi geçici görev bordroları hazır oluyor. vs. 4- Özel hizmet puantayı, Özel hizmet bordrosu, Özel hizmet banka ödeme, uf uf hepsini yazmam çok zaman alacak, bir ara buraya eklerim inşallah. www.akdyazilim.com

üstad eline sağlık lakin ben dosyamı eklemişim, keşke doğrudan reklam yapmak yerine öncelikle benim dosyam üzerinden yardımcı olmaya çalışsaydın. neyse hayırlı geceler.
 
ve son olarak da kayıt defterindeki kayıtlar silindiğinde otomatik olarak puantajdaki kayıtların da silinme imkanı yok mudur?

topluca silmeyi buldum da mesela bir kayıdı deftere yanlışlıkla aktardım, onu sildiğimde puantajdaki o kayıt da silinsin.

üstadım çok önemli değil ama olsa mükemmel olacaktır.
 
Hafta sonunu ne için tanımlayacağız? Sadece renk olarak mı belirteceğiz?
 
Üstadım uğraştın yaptın fakat ben burdan indiremiyorum. Dosya.tc den yükleyebilirsen alabilirim. Altın üyeliğim yok
 
hocam bu haftasonlarını yapmanın mantığı nedir. maaş puantajıma da ekleyim bunu ben
 
hocam bir de bir sorun var. sadece tek kayıtı silmek için koymuş olduğunuz sil butonuyla belirli tarihteki kayıdı siliyor sıkıntı yok fakat. defterde sadece tek kayıt olduğunda,yani sadece 1. satırda veri olup da onu silmeye kalkınca sıra numarası bölümünde 2 yazıyor. yukardaki sıra no yazan yeri de 1 ile değiştiriyor.

bir de bir tarihte iki ya da daha fazla kayıt varsa bunları kayıt defterinde tek tek siliyor fakat puantajda o tarihe ait kayıtların tamamını tek seferde siliyor.
 
Son düzenleme:
Sub Sil()
Application.ScreenUpdating = False

adet = WorksheetFunction.CountIf(Sheets("Kayıt Defteri").Range("B3:B1003"), Range("I2"))
If adet = 0 Then
MsgBox Range("I2") & " tarihli kayıt bulunamadı.", vbInformation, "İdari ve Mali İşler, Sefa BURAN"
Exit Sub
End If

20
kaç = WorksheetFunction.Match(Range("I2"), Sheets("Kayıt Defteri").Range("B3:B1003"), 0) + 2
Sheets("Kayıt Defteri").Range("B" & kaç & ":M1003") = Sheets("Kayıt Defteri").Range("B" & kaç + 1 & ":M1004").Value

adet = WorksheetFunction.CountIf(Sheets("Kayıt Defteri").Range("B3:B1003"), Range("I2"))
If adet > 0 Then GoTo 20

Sheets("Kayıt Defteri").Range("A3:A1003") = ""
son = Sheets("Kayıt Defteri").Cells(Rows.Count, 2).End(3).Row

If son = 2 Then GoTo 15
Sheets("Kayıt Defteri").Range("A3:A" & son) = "=ROW(A1)"
Sheets("Kayıt Defteri").Range("A3:A" & son) = Sheets("Kayıt Defteri").Range("A3:A" & son).Value
15

a = Month(Range("I2"))
b = Day(Range("I2"))
süt = a * 32 - 30 + b
Sheets("Puantaj").Range(Sheets("Puantaj").Cells(4, süt), Sheets("Puantaj").Cells(22, süt)) = ""

MsgBox Range("I2") & " tarihli veriler silindi.", vbInformation, "İdari ve Mali İşler, Sefa BURAN"

End Sub
Sil kodununu bu kod ile değiştirin.
 
Son düzenleme:
Tatil günleri ve hafta sonlarınkoşullu biçimlendirme ile belirtilmiştir.
 
O konuda bir fikrim yok. Tam olarak dosya ile ne yapmak istediğinizi anlamadım. A10:I49 arasını birleştirdiğiniz zaman ne gibi bir problem oluyor?
 
Geri
Üst