Hizmet aracı km takip ve puantaj bir arada

[zehnisağcan]

Saygıdeğer exel.web.tr de emek veren hocalarım yine sizin bilgilerinize ihtiyacım var.

Benim günlük olarak yapmış olduğum işleri kolaylaştırmak istiyorum sizlerinde emekleri sayesinde

ekde vermiş olduğum çalışmada ihtiyacım olan şu:

şubat 10 sayfasındaki plaka yazılı bölümlerdeki

1-şubat 10 sayfasındaki günlere göre db 832-aj 554-aj 381 bölümlerindeki "d"-"ı"-"n" sütunlarını araçın plakası yazılı olan sayfalarda, günlere göre 5.satıra aktarma buton veya otomatik olarak

2-cumartesi - pazar ve diğer resmi tatillerde çalışma yapılmış ise yine 7.satırdaki hangi gün yapılmış ise o güne aktarma

başka uygulamalara baktım ama istediğim bir uygulama bulamadım sizden ricam yardımcı olursanız çokkkk makbule geçecek

ekdeki vermiş olduğum çalışmada örnek olarak belirtim

 

[zehnisağcan]

Ekli çalışmanın şifresi :1848 dir özür dilerim

 

[leumruk]

Merhaba,

Sub Aktar()
Set s1 = Sheets("Şubat 10")
Application.ScreenUpdating = False
For x = 1 To 11 Step 5
Set syf = Sheets(s1.Cells(1, x).Text)
s1.Range(s1.Cells(3, x + 3), s1.Cells(30, x + 3)).Copy
syf.[d5].PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
Next
MsgBox "İşlem tamam.", vbInformation, "DURUM"
Application.ScreenUpdating = True
End Sub

 

[zehnisağcan]

Elinize sağlık hocam
yalnız hafta sonu yapılan çalışmayı 7.satıra atmıyor ulusal tatiller ve cumartesi pazar günlerini

BİRDE HAFTA SONU ÇALIŞMASI YOK AMA 50 YAZIYOR SİZİN ÖRNEKDE DENEME YAPTIM EKDE

 

[leumruk]

Haftasonundan kastınız Şubat 10 sayfasındaki sarı alanlar mı? tablonun birini doldurup olmasını istediğiniz şekilde plakalardan birinin sayfasına ekler misiniz?

 

[zehnisağcan]

Pikap km çalıması

Merhaba hocam

subat 10 sayfasındaki sarı alanlar evet hocam kastım

aj 381 plaka ya örnek ekledim olmasını istediğim gibi(şubat 10 ile aj 381) sayfasında görebilirsiniz

sarı alanlar değişken ay ay yalnız hocam

 

[leumruk]

Hafta sonlarını kırmızı fontla yazmışsınız. Tatil günlerini kırmızı fontla yazdığınızı farz ederek bir kod hazırladım.

Sub Aktar()
Set s1 = Sheets("Şubat 10")
Application.ScreenUpdating = False
For x = 1 To 11 Step 5
Set syf = Sheets(s1.Cells(1, x).Text)
For y = 3 To 30
If s1.Cells(y, x).Font.ColorIndex = 3 Then
syf.Cells(7, y + 1) = s1.Cells(y, x [COLOR="Red"]+ 3[/COLOR])
Else:
syf.Cells(5, y + 1) = s1.Cells(y, x [COLOR="red"]+ 3[/COLOR])
End If
Next
Next
MsgBox "İşlem tamam.", vbInformation, "DURUM"
Application.ScreenUpdating = True
End Sub

Not: Eklediğiniz örneklerde Şubat 10 sayfasındaki plaka adlarının başında boşluk bırakıyorsunuz. Buna dikkat edin, yoksa kod hata verecektir.

 

[zehnisağcan]

Farklı değerler atıyor hocam eklemiş olduğunuz çalışma

 

[zehnisağcan]

Araç puantaj km takip

Merhaba hocam şubat 10 daki hafta sonlarını kırmızı yaptım ve aktar değimde 40 küsürlerle başlayan rakam atıyor

çalışma ekdedir

 

[leumruk]

Kodları denemeden çıkmam gerektiğinden gözden kaçırmışım. Kodları ve dosyayı güncelledim. Yeniden deneyebilirsiniz.

 

[zehnisağcan]

çok güzel oldu hocam ellerine sağlık çokk savoll.

plakalardaki 4 ve 6 satırlara yani gün e 5 ve 7 de değer var ise 1 yazdırabilirmiyiz

ben bu (=EĞER(D5;1;0) formülle de yaptırabilirim ama macro ile yapılırsa ii olur gibi ama siz bilirsiniz.

 

[leumruk]

Aşağıdaki kodu deneyin.

Sub Aktar()
Set s1 = Sheets("Şubat 10")
Application.ScreenUpdating = False
For x = 1 To 11 Step 5
Set syf = Sheets(s1.Cells(1, x).Text)
For y = 3 To 30
If s1.Cells(y, x).Font.ColorIndex = 3 Then
syf.Cells(7, y + 1) = s1.Cells(y, x + 3)
Else:
syf.Cells(5, y + 1) = s1.Cells(y, x + 3)
End If
[COLOR="Red"]If syf.Cells(5, y + 1) <> "" Then syf.Cells(4, y + 1) = 1
If syf.Cells(7, y + 1) <> "" Then syf.Cells(6, y + 1) = 1[/COLOR]
Next
Next
MsgBox "İşlem tamam.", vbInformation, "DURUM"
Application.ScreenUpdating = True
End Sub

 

[zehnisağcan]

"d"-"ı"-"n" sütunlarındaki satırlarda değer var ise plakalardaki 4 ve 6 satırlardaki günlere 1 yazsın hocam

eklemiş olduğunuz macroyu uyguladım ama bütün hepsine 1 yazıyor değer gözetmiyor

deneme maksatlı şubat 10 sayfasında sadece bir plakaya değer işledim ve aktar dediğimde diğer plaka sayfalarının 4 ve 6 satırına da işliyor hocam

"sizede zahmet veriyorum ama gerçekden yardımlarınız için çok teşekür ederim."

 

[zehnisağcan]

leumruk hocam buralarda yok galiba

 

[Korhan Ayhan]

Selamlar,

#12 nolu mesajda size önerilen koddaki kırmızı renkli satırlardaki "" (çift tırnak) işaretleri yerine sıfır yazıp aktarım yapmayı denermisiniz.

 

[zehnisağcan]

Korhan hocamında yardımları ile sorunum çözülmüş oldu
dört dörtlük bir çalışma oldu

"leumruk" ve "korhan ayhan" hocama yardımlarını esirgemedikleri için sonsuz teşekür ederim