Soru Verilen Tarihleri (sadece günler) "24" yazdırmak

[ozcanya]

Merhabalar;
benim yapmak istediğim, bir kısa çalışma sayfasından "24 gönder"" nöbet listeme ayın sadece günlerini yazarak nöbet listesine karşılık gelen günlere "24" olarak (bu nöbet saatidir.) yazdırmak. bu şekilde hızlı hareket edeceğimi düşündüm. Yardımlarınızı rica ediyorum. Örnek dosya ekledim içerisinde açıklama ve örnek mevcut.

 

[ÖmerFaruk]

Siz nöbet listesi 1 sayfasında ilgili hücrelere R ve i değerleri de giriyorsunuz ve bunu manuel yapıyorsunuz.
Formülle o hücreye 24 yazabiliriz ama bu durumda R ve i yi nasıl gireceksiniz?

 

[ozcanya]

Siz nöbet listesi 1 sayfasında ilgili hücrelere R ve i değerleri de giriyorsunuz ve bunu manuel yapıyorsunuz.
Formülle o hücreye 24 yazabiliriz ama bu durumda R ve i yi nasıl gireceksiniz?

sayın ömer faruk bey R ve İ değerleri manuel olarak girilecek. benim Sizden talebim Sadece "24" ataması yapmak .formülle yapmak benim çalışmama uymaz bunu makro ile yapmak daha çok işime yarayacak. daha önce Ziynettin beyden bu işlemin tersi için yaradım almıştım. Bağlantıyı atıyorum. https://www.excel.web.tr/threads/24-karsilik-gelen-guenler.199359/
burada çalışmanın tersi.
teşekkür ederim. İyi akşamlar

 

[ÖmerFaruk]

O zaman şunu sorayım, eğer 24 yazılacak hücrede R ya da i varsa nasıl bir işlem uygulanacak?

 

[ozcanya]

O zaman şunu sorayım, eğer 24 yazılacak hücrede R ya da i varsa nasıl bir işlem uygulanacak?

"R" raporu ifade eder "i" izni ifade eder. ben açıklama kısmına bu bilgiyi yazmayı unuttum özür dilerim sizden. durum değişikliklerini manuel olarak giriyorum. Bu sorun değil. sadece 24 ataması yapması bana yeterlidir. teşekkür ederim.

 

[ÖmerFaruk]

Aşağıdaki kodları bir modül içine ekleyip çalıştırırabilirsiniz.
Worksheet Change olayında kodlarınız var ama onları şu an etkilemiyor.

Ben kodları denedim ve doğru sonuç aldığını gördüm.

Sub YirmiDort()
    Dim i As Integer, x As Integer, isim As Range, s1 As Worksheet, s2 As Worksheet, Kolon As Integer
    Set s1 = Worksheets("24 gönder")
    Set s2 = Worksheets("nöbet listesi 1")
    
    Set isim = s1.Range("B3")
    i = 0
    Do Until isim.Offset(i, 0) = ""
        Kolon = Empty
        On Error Resume Next
        Kolon = WorksheetFunction.Match(isim.Offset(i, 0), s2.Rows(2), 0)
        If Kolon Then
            x = 1
            Do Until isim.Offset(i, x) = ""
                s2.Range("A2").Offset(isim.Offset(i, x), Kolon - 1) = 24
                x = x + 1
            Loop
        End If
        i = i + 1
    Loop
    On Error GoTo 0
End Sub

 

[ozcanya]

Aşağıdaki kodları bir modül içine ekleyip çalıştırırabilirsiniz.
Worksheet Change olayında kodlarınız var ama onları şu an etkilemiyor.

Ben kodları denedim ve doğru sonuç aldığını gördüm.

Sub YirmiDort()
    Dim i As Integer, x As Integer, isim As Range, s1 As Worksheet, s2 As Worksheet, Kolon As Integer
    Set s1 = Worksheets("24 gönder")
    Set s2 = Worksheets("nöbet listesi 1")
  
    Set isim = s1.Range("B3")
    i = 0
    Do Until isim.Offset(i, 0) = ""
        Kolon = Empty
        On Error Resume Next
        Kolon = WorksheetFunction.Match(isim.Offset(i, 0), s2.Rows(2), 0)
        If Kolon Then
            x = 1
            Do Until isim.Offset(i, x) = ""
                s2.Range("A2").Offset(isim.Offset(i, x), Kolon - 1) = 24
                x = x + 1
            Loop
        End If
        i = i + 1
    Loop
    On Error GoTo 0
End Sub

Bende kontrol ettim mükemmel olmuş. Zaman ayırdınız için teşekkür ederim. Ellerinize sağlık..
hafta içi diğer günler sekiz (8) göndermek mümkün müdür? değilse bu şekilde kalabilir. Sadece hafta içi

 

[ozcanya]

Bende kontrol ettim mükemmel olmuş. Zaman ayırdınız için teşekkür ederim. Ellerinize sağlık..
hafta içi diğer günler sekiz (8) göndermek mümkün müdür? değilse bu şekilde kalabilir. Sadece hafta içi

Baştan aklıma gelmedi özür dilerim. Herhangi bir tarih girmeden hafta içlerini 8 olarak doldurmak mümkün müdür?

 

[ÖmerFaruk]

Mümkün değil

 

[ÖmerFaruk]

Aşağıdaki kodları kullanabilirsiniz.

Not:Sorunuza 2 kez soru sordum zira eksik tanımlamıştınız. Şimdi bu ilavenizi de cevaplıyorum. Sürekli aynı soruya dönüp ilave yapmak revize etmekten haz etmiyorum. Soru sahipleri sorularını tek seferde eksiksiz sorsalar her şey daha güzel olacak.

Sub YirmiDort()
    Dim Dict As Object, i As Integer, x As Integer, isim As Range, s1 As Worksheet, s2 As Worksheet, Kolon As Integer
    Set s1 = Worksheets("24 gönder")
    Set s2 = Worksheets("nöbet listesi 1")
    Set Dict = CreateObject("Scripting.Dictionary")
    Set isim = s1.Range("B3")
    i = 0
    Do Until isim.Offset(i, 0) = ""
        Kolon = Empty
        On Error Resume Next
        Kolon = WorksheetFunction.Match(isim.Offset(i, 0), s2.Rows(2), 0)
        If Kolon Then
            s2.Range("A2").Offset(1, Kolon - 1).Resize(31, 1).ClearContents
            For x = 1 To isim.Offset(i, 0).End(xlToRight).Column - 2
                If Not Dict.Exists(isim.Offset(i, x)) Then Dict.Add isim.Offset(i, x) * 1, 1
            Next x
            For x = 1 To 31
                If Dict.Exists(x) Then
                    s2.Range("A2").Offset(x, Kolon - 1) = 24
                ElseIf WorksheetFunction.Weekday(s2.Range("A2").Offset(x, 0), 2) <= 5 Then
                    s2.Range("A2").Offset(x, Kolon - 1) = 8
                End If
            Next x
        End If
        i = i + 1
        Dict.RemoveAll
    Loop
    On Error GoTo 0
End Sub

 

[ozcanya]

Aşağıdaki kodları kullanabilirsiniz.

Not:Sorunuza 2 kez soru sordum zira eksik tanımlamıştınız. Şimdi bu ilavenizi de cevaplıyorum. Sürekli aynı soruya dönüp ilave yapmak revize etmekten haz etmiyorum. Soru sahipleri sorularını tek seferde eksiksiz sorsalar her şey daha güzel olacak.

Sub YirmiDort()
    Dim Dict As Object, i As Integer, x As Integer, isim As Range, s1 As Worksheet, s2 As Worksheet, Kolon As Integer
    Set s1 = Worksheets("24 gönder")
    Set s2 = Worksheets("nöbet listesi 1")
    Set Dict = CreateObject("Scripting.Dictionary")
    Set isim = s1.Range("B3")
    i = 0
    Do Until isim.Offset(i, 0) = ""
        Kolon = Empty
        On Error Resume Next
        Kolon = WorksheetFunction.Match(isim.Offset(i, 0), s2.Rows(2), 0)
        If Kolon Then
            s2.Range("A2").Offset(1, Kolon - 1).Resize(31, 1).ClearContents
            For x = 1 To isim.Offset(i, 0).End(xlToRight).Column - 2
                If Not Dict.Exists(isim.Offset(i, x)) Then Dict.Add isim.Offset(i, x) * 1, 1
            Next x
            For x = 1 To 31
                If Dict.Exists(x) Then
                    s2.Range("A2").Offset(x, Kolon - 1) = 24
                ElseIf WorksheetFunction.Weekday(s2.Range("A2").Offset(x, 0), 2) <= 5 Then
                    s2.Range("A2").Offset(x, Kolon - 1) = 8
                End If
            Next x
        End If
        i = i + 1
        Dict.RemoveAll
    Loop
    On Error GoTo 0
End Sub

Haklısınız yoğun iş temposundayız.çok teşekkür ederim (sağlık personeliyim)