• DİKKAT

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

  • Forum yazılımı güncelenmiştir.

    Beklenmedik durumlar görürseniz lütfen yönetime iletin.

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

O

ozcanya

Katılım
3 Haziran 2006
Mesajlar
418
Excel Vers. ve Dili
excel 2003 Türkçe
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.
 

Ekli dosyalar

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?
 
ÖmerFaruk' Alıntı:
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?
Genişletmek için tıkla ...
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
 
O zaman şunu sorayım, eğer 24 yazılacak hücrede R ya da i varsa nasıl bir işlem uygulanacak?
 
ÖmerFaruk' Alıntı:
O zaman şunu sorayım, eğer 24 yazılacak hücrede R ya da i varsa nasıl bir işlem uygulanacak?
Genişletmek için tıkla ...
"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.
 
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.
C++: 
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
 
ÖmerFaruk' Alıntı:
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.
C++: 
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
Genişletmek için tıkla ...
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
 
Son düzenleme:
ozcanya' Alıntı:
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
Genişletmek için tıkla ...
Baştan aklıma gelmedi özür dilerim. Herhangi bir tarih girmeden hafta içlerini 8 olarak doldurmak mümkün müdür?
 
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.

C++: 
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
 
ÖmerFaruk' Alıntı:
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.

C++: 
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
Genişletmek için tıkla ...
Haklısınız? yoğun iş temposundayız.çok teşekkür ederim (sağlık personeliyim)
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst