Çözüldü Hücre değerine göre diğer sütunlara veri yazma

tukayf · 29 Eylül 2022

Merhabalar hocalarım. Beni aşan bi mevzu da yardımlarınızı rica ediyorum. Ekteki dosyada açıklama yaptım umarım yeterli olur açıklama. Kısaca H1 de seçilen gruba göre diğer sütunlara veri yazdırmak istiyorum.

tukayf · 29 Eylül 2022

Yardımcı olabilecek hocam var ise sayfa olayına değil de option buton ile yüpübilir miyiz bu işlemi.

Korhan Ayhan · 29 Eylül 2022

Merhaba,

Deneyiniz. Sayfanızın kod bölümüne uygulayınız.

H1 hücresindeki listeniz H sütunundaki verilerle birebir aynı olmaldır.

C++:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    
    If Intersect(Target, Range("H1")) Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False
    
    Select Case Target
        Case "1. Grup"
            With Range("$A$4:$T$" & Rows.Count)
                .AutoFilter Field:=8, Criteria1:=Target
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("Q5:R" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "09:00"
            End With
        Case "2. Grup", "3. Grup"
            With Range("$A$4:$T$" & Rows.Count)
                .AutoFilter Field:=8, Criteria1:=Target
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("T5:T" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "İstirahatli"
            End With
        Case "Müracaat", "DBK"
            With Range("$A$4:$T$" & Rows.Count)
                .AutoFilter Field:=8, Criteria1:=Target
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("Q5:Q" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "09:00"
                Set Rng = Range("R5:R" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "18:00"
            End With
    End Select
    
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0

    Application.ScreenUpdating = True
End Sub

tukayf · 29 Eylül 2022

Hocam zihninize sağlık. 1. Grup seçiminde çalışıyor. Ancak 2. grup seçildiğinde 1. grup için uygalanan işlemleri 2. grup için yapmasını istemiştim. Sanırım eksik anlatmışım.
3. grup seçildiğinde ise 1. grupta hangi işlemi yaptıysa aynı işlem uygulanacaktı. 1. grubu seçtiğimde 1. gruba saatler yazdırılacak. diğer gruplara istirahatli yazılacak. 2. grubu seçtiğimde 2 gruba saatler diğer iki gruba ise istirahatli yazılacaktı. 3. grup için de aynı koşullar gerekli. Sizin kodları çoğaltsam çözüm olabilir mi. Çözümünüz için tekrar teşekkürler.

Korhan Ayhan · 29 Eylül 2022

Denemekten zarar gelmez..

tukayf · 29 Eylül 2022

Sn. Hocam denedim ve başaramadım. 1. Grup seçiminde 1. gruplara saat diğer gruplara ise istirahatli yazacak. 2. Grup seçiminde ise 2. gruba saat 1 ve 3 gruplara istirahatli yazacak. 3. grup seçiminde ise 3. gruba saat diğer gruplara ise istirahatli yazacak. her seferinde bir önceki seçimi sildirip tekrardan atama yapmamız mümkün müdür acaba.

1. Grup seçiminde diğer gruplara istirahatli yazdırabileceğimiz kodu yazabilirseniz sanırım çoğaltabilirim.

Korhan Ayhan · 29 Eylül 2022

"P" sütunu boş ise koşulu vardı. Bu durumda o koşul iptal mi oldu?

tukayf · 29 Eylül 2022

hayır hocam o koşul hala geçerli tüm gruplar için.

Korhan Ayhan · 29 Eylül 2022

1. Grup seçimi için aşağıdaki kod bloğunu deneyiniz.

C++:

    Select Case Target
        Case "1. Grup"
            With Range("$A$4:$T$" & Rows.Count)
                .AutoFilter Field:=8, Criteria1:=Target
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("Q5:R" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "09:00"
            
                .AutoFilter Field:=8, Criteria1:="<>" & Target
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("T5:T" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "İstirahatli"
            End With

tukayf · 29 Eylül 2022

Budur hocam. Çok teşekkür ederim. Peki 1. 2. ve 3. grupta olmayan personelin karşısına 09.00 18.00 saatlerini nasıl yazdırabiliriz.

tukayf · 29 Eylül 2022

Hocam tüm koşullara göre sayfaları düzenleyerek tekrar yükledim dosyayı. İlgilenebilirseniz müteşekkir olurum.

Korhan Ayhan · 29 Eylül 2022

Tüm koşulları sırasıyla adım adım yazar mısınız?

tukayf · 29 Eylül 2022

Tabi ki hocam.
1. şart H1=1. Grup olduğunda P sütunu boş ise H sütununda 1. Grup yazan tüm personel için N ve O sütunlarına 09.00 yazılacak. 2. ve 3 gruplarda ise yine P sütunu boş ise T sütununa "İstirahatli" yazacak. H sütununda DBK yazan personel hariç geri kalan tüm personel için yine P sütunu boş ise N sütununa 09.00 O sütununa ise 18.00 yazacak.
2. şart H1=2. Grup olduğunda P sütunu boş ise H sütununda 2. Grup yazan tüm personel için N ve O sütunlarına 09.00 yazılacak. 1. ve 3 gruplarda ise yine P sütunu boş ise T sütununa "İstirahatli" yazacak. H sütununda DBK yazan personel hariç geri kalan tüm personel için yine P sütunu boş ise N sütununa 09.00 O sütununa ise 18.00 yazacak.
3. şart H1=3. Grup olduğunda P sütunu boş ise H sütununda 3. Grup yazan tüm personel için N ve O sütunlarına 09.00 yazılacak. 1. ve 2 gruplarda ise yine P sütunu boş ise T sütununa "İstirahatli" yazacak. H sütununda DBK yazan personel hariç geri kalan tüm personel için yine P sütunu boş ise N sütununa 09.00 O sütununa ise 18.00 yazacak.
H1 hücresinde her tetiklendiğinde verilerin silinerek yenilenmesi gerekiyor hocam.

Bir koşul daha var yapılabilirse I1=Tatil yazdığı zaman gruplar ve DBK dışında kalan tüm personelin N ve O sütunlarındaki saatler silinerek T sütununa "İstirahatli" yazılacak.
Umarım bu sefer anlatabilmişimdir. Sabrınız ve emekleriniz için Allah razı olsun.
Çok teşekkürler.

tukayf · 30 Eylül 2022

Hocam çözümü yok mudur?

tukayf · 2 Ekim 2022

Değerli hocalarım konu halen güncel?

Korhan Ayhan · 3 Ekim 2022

"Müracaat", "DBK" seçimleri için ne yapılacacak bunu belirtmemişsiniz? Gerçi sonradan farkettim bunlar zaten H1 hücresinden seçilemiyor.

Ayrıca "H1 hücresinde her tetiklendiğinde verilerin silinerek yenilenmesi gerekiyor hocam. " ifadenizden ne anlamalıyım?

Diyelim ki "1. Grup" seçildi işlemler yapıldı. Sonra 2. Grup" seçildi. Bu aşamada neler silinecek?

tukayf · 3 Ekim 2022

Korhan Ayhan' Alıntı:

"Müracaat", "DBK" seçimleri için ne yapılacacak bunu belirtmemişsiniz? Gerçi sonradan farkettim bunlar zaten H1 hücresinden seçilemiyor.

Genişletmek için tıkla ...

Korhan Ayhan' Alıntı:
DBK için hiç bir koşulda işlem yapılmıyor hocam. Müracaat ve NBA yazanlar için ise N sütununa 09.00 O sütununa ise 18.00 yazılacak. I1 Tatil yazdığında ise "T sütununa "İzinli" yazılacak.
Ayrıca "H1 hücresinde her tetiklendiğinde verilerin silinerek yenilenmesi gerekiyor hocam. " ifadenizden ne anlamalıyım?
Hocam H1 hücresi değiştiğinnde

H1=1. Grup olduğunda P sütunu boş ise H sütununda 1. Grup yazan tüm personel için N ve O sütunlarına 09.00 yazılacak. 2. ve 3 gruplarda ise yine P sütunu boş ise T sütununa "İstirahatli" yazacak. H sütununda DBK yazan personel hariç geri kalan tüm personel için yine P sütunu boş ise N sütununa 09.00 O sütununa ise 18.00 yazacak.
H1=2. Grup olduğunda P sütunu boş ise H sütununda 2. Grup yazan tüm personel için N ve O sütunlarına 09.00 yazılacak. 1. ve 3 gruplarda ise yine P sütunu boş ise T sütununa "İstirahatli" yazacak. H sütununda DBK yazan personel hariç geri kalan tüm personel için yine P sütunu boş ise N sütununa 09.00 O sütununa ise 18.00 yazacak.
H1=3. Grup olduğunda P sütunu boş ise H sütununda 3. Grup yazan tüm personel için N ve O sütunlarına 09.00 yazılacak. 1. ve 2 gruplarda ise yine P sütunu boş ise T sütununa "İstirahatli" yazacak. H sütununda DBK yazan personel hariç geri kalan tüm personel için yine P sütunu boş ise N sütununa 09.00 O sütununa ise 18.00 yazacak.

Diyelim ki "1. Grup" seçildi işlemler yapıldı. Sonra 2. Grup" seçildi. Bu aşamada neler silinecek?
Hocam silinecek veri yok bunu yanlış yazmışım.

Korhan Ayhan · 4 Ekim 2022

Deneyiniz.

C++:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    
    If Intersect(Target, Range("H1,I1")) Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False
    
    Select Case Target
        Case "1. Grup"
            With Range("$A$4:$T$" & Rows.Count)
                .AutoFilter Field:=8, Criteria1:=Target
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("N5:O" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "09:00"
            
                .AutoFilter Field:=8, Criteria1:="=2. Grup", Operator:=xlOr, Criteria2:="=3. Grup"
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("T5:T" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "İstirahatli"
                
                .AutoFilter Field:=8, Criteria1:="=Müracaat", Operator:=xlOr, Criteria2:="=NBA"
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("N5:N" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "09:00"
            
                Set Rng = Range("O5:O" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "18:00"
            End With
        Case "2. Grup"
            With Range("$A$4:$T$" & Rows.Count)
                .AutoFilter Field:=8, Criteria1:=Target
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("N5:O" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "09:00"
            
                .AutoFilter Field:=8, Criteria1:="=1. Grup", Operator:=xlOr, Criteria2:="=3. Grup"
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("T5:T" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "İstirahatli"
                
                .AutoFilter Field:=8, Criteria1:="=Müracaat", Operator:=xlOr, Criteria2:="=NBA"
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("N5:N" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "09:00"
            
                Set Rng = Range("O5:O" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "18:00"
            End With
        Case "3. Grup"
            With Range("$A$4:$T$" & Rows.Count)
                .AutoFilter Field:=8, Criteria1:=Target
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("N5:O" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "09:00"
            
                .AutoFilter Field:=8, Criteria1:="=1. Grup", Operator:=xlOr, Criteria2:="=2. Grup"
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("T5:T" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "İstirahatli"
                
                .AutoFilter Field:=8, Criteria1:="=Müracaat", Operator:=xlOr, Criteria2:="=NBA"
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("N5:N" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "09:00"
            
                Set Rng = Range("O5:O" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "18:00"
            End With
        Case "Müracaat", "NBA"
            With Range("$A$4:$T$" & Rows.Count)
                .AutoFilter Field:=8, Criteria1:=Target
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("N5:N" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "09:00"
                Set Rng = Range("O5:O" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "18:00"
            End With
        Case "Tatil"
            With Range("$A$4:$T$" & Rows.Count)
                .AutoFilter Field:=8, Criteria1:="=Müracaat", Operator:=xlOr, Criteria2:="=NBA"
                .AutoFilter Field:=16, Criteria1:="="
            
                Set Rng = Range("N5:O" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = ""
                
                Set Rng = Range("T5:T" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible)
                If Not Rng Is Nothing Then Rng.Value = "İstirahatli"
            End With
    End Select
    
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0

    Application.ScreenUpdating = True
End Sub

tukayf · 4 Ekim 2022

Merhabalar Korhan Bey maalesef şu an pc ye erişimim yok. Yarın sabah dönüş yapabilirim. Zihninize sağlık çok teşekkür ederim.

tukayf · 5 Ekim 2022

Hocam zihninize sağlık. Eksik anlatım nedeniyle farklı olan kodları düzenlemeye çalışıyorum. Gayet işlevsel hale geldi şu an çok teşekkürler.

Çözüldü Hücre değerine göre diğer sütunlara veri yazma

tukayf

Ekli dosyalar

tukayf

Korhan Ayhan

Administrator

tukayf

Korhan Ayhan

Administrator

tukayf

Korhan Ayhan

Administrator

tukayf

Korhan Ayhan

Administrator

tukayf

tukayf

Ekli dosyalar

Korhan Ayhan

Administrator

tukayf

tukayf

tukayf

Korhan Ayhan

Administrator

tukayf

Korhan Ayhan

Administrator

tukayf

tukayf