• DİKKAT

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

Günlere göre kişi sayılarını dağıtma

I

imyourfate

Katılım
24 Mart 2011
Mesajlar
139
Excel Vers. ve Dili
excel 2007 türkçe
Arkadaşlar değerli hocalarım hayırlı günler,

buradaki sorunumu daha önce yazdım ama pek iyi açıklayamadım sanıyorum hemen kısaca anlatmam gerekirse akte yeralan dosyada rezervasyon sekmesinde ''B'' sütununda bulunan rakamlar ''E ve F'' sütunlarında bulunan tarihlere göre ''Forecast'' sayfası 8.satırda bulunan Total kişi satırına ayın birinden itibaren makro yardımıyla yazdırılacak
 

Ekli dosyalar

Not: Deneme fırsatım olmadı.
Kod: 
Sub Dagit()
    Sheets("FORECAST").[B8:AF8].ClearContents
    For i = 2 To 8
        s = Day(Sheets("Rezervasyon").Cells(i, "f"))
        b = Day(Sheets("Rezervasyon").Cells(i, "e"))
        For j = b To s
            Sheets("FORECAST").Cells(8, j + 1) = Sheets("Rezervasyon").Cells(i, 2) + Sheets("FORECAST").Cells(8, j + 1)
        Next
    Next
    MsgBox "Bitti"
End Sub
 
Hamitcan hocam on numara çalışma lakin küçük iki detay var ''rezervasyon'' sayfasında ''F'' sütunundaki tarih çıkış tarihi diğer sayfada kişi sayısı en son bir gün önce bitmeli örnek: çıkış tarihi 15.01.13 ise son kişi bir gün önceye yazılmalı -1 olmalı.
ikinci husus tabloyu güncelledim benim hatam size sadece ocak ayını verdim ama 12 aylık bir tablo olması gerekiyor ve ay geçişleri mevcut ocak girer şubat çıkar dahi olsa kişi sayıları ocak'tan şubat'a ve diğer aylarada devam etmeli

Ellerinize sağlık hayırlı işler diliyorum

Saygılarımla
 

Ekli dosyalar

Arkadaşlar hayırlı günler,

Aşağıdaki makroyu Hamitcan hoca yazdı ben kendime göre düzenledim ekte dosyada görebileceğiniz gibi mükemmel çalışıyor ama bu makroya nasıl bir ekleme yapmalıyım ki ''forecast'' sayfasında diğer aylarada devam edebilsin daha önce başka bir çalışmamda kullandığım ay geçişlerini yapabilen bir makroyuda ''modül 1''e örnek olarak koydum herhangi bir şifre yoktur

Yardımlarınızı rica eder saygılarımı sunarım.

Private Sub Worksheet_Activate()
Sheets("FORECAST").[c8:Ag8].ClearContents
For i = 2 To 20000
s = Day(Sheets("Rezervasyon").Cells(i, "g"))
b = Day(Sheets("Rezervasyon").Cells(i, "f"))
For j = b To s - 1
Sheets("FORECAST").Cells(8, j + 2) = Sheets("Rezervasyon").Cells(i, 3) + Sheets("FORECAST").Cells(8, j + 2)
Next
Next


End Sub
 

Ekli dosyalar

İki tarih arasında bir aydan fazla fark olmadığı sürece doğru çalışır. Diğer kısmın mantığını henüz kuramadım.
Kod: 
Sub Dagit()
Temizle
With Sheets("Rezervasyon")
    For i = 2 To 8
        AyBasi = Month(.Cells(i, "e"))
        AySonu = Month(.Cells(i, "f"))
        GunBasi = Day(.Cells(i, "e"))
        GunSonu = Day(.Cells(i, "f"))
    If AySonu = AyBasi Then
        s = Satir(AyBasi)
        For j = GunSonu + 1 To GunBasi + 1 Step -1
          Sheets("FORECAST").Cells(s, j) = .Cells(i, 2) + Sheets("FORECAST").Cells(s, j)
        Next j
    ElseIf AySonu - AyBasi = 1 Then
        s = Satir(AyBasi)
        For j = GunBasi + 1 To AyCekeri(Year(.Cells(i, "e")), Month(.Cells(i, "e"))) + 1
          Sheets("FORECAST").Cells(s, j) = .Cells(i, 2) + Sheets("FORECAST").Cells(s, j)
        Next j
        s = Satir(AySonu)
        For j = 2 To GunSonu + 1
          Sheets("FORECAST").Cells(s, j) = .Cells(i, 2) + Sheets("FORECAST").Cells(s, j)
        Next j
    
    End If
    Next
End With
End Sub
Sub Temizle()
    For i = 8 To 107 Step 9
         Range("b" & i & ":" & "af" & i).ClearContents
    Next
End Sub
Function Satir(Ay)
    If Ay = 1 Then Satir = 8
    If Ay = 2 Then Satir = 17
    If Ay = 3 Then Satir = 26
    If Ay = 4 Then Satir = 35
    If Ay = 5 Then Satir = 44
    If Ay = 6 Then Satir = 53
    If Ay = 7 Then Satir = 62
    If Ay = 8 Then Satir = 71
    If Ay = 9 Then Satir = 80
    If Ay = 10 Then Satir = 89
    If Ay = 11 Then Satir = 98
    If Ay = 12 Then Satir = 107
End Function
Function AyCekeri(Yil, Ay)
        AyCekeri = Day(DateSerial(Yil, Ay + 1, 0))
End Function
 
:( çalışmadı hocam modül 1 deki makro da kişileri değilde odaları dağıtıyor ve aygeçişlerini muntazaman yapıyor ama çözemedim
 
Hocam ekteki dosya da call dizisi ile bağlı ''dağıt'' makrosu umarım işinize yarar
 

Ekli dosyalar

Arkadaşlar iyi akşamlar
Bu konuda yardımcı olabilecek biri varsa

Teşekkür ederim
 
Arkadaşlar iyi akşamlar
Bu konuda yardımcı olabilecek biri varsa Teşekkür ederim
 
Merhaba,
Sub Dağıt()
Set f = Sheets("Forecast")
f.Range("B10:AF10") = "=B8+B9"
For i = 2 To 8
f.Range(f.Cells(9, 2), f.Cells(9, Cells(i, 7) + 1)) = Cells(i, 2).Value
f.Range("B8:AF8") = f.Range("B10:AF10").Value
f.Range("B9:AF9") = ""
Next
f.Range("B9:AF10") = ""
Set f = Nothing
End Sub
Genişletmek için tıkla ...
Kodu deneyiniz.
 
Muhammet hocam ilginize teşekkür ederim ama çalışmadı dosyamı tekrar ekledim burada sorun sadece kişi sayısının diğer aylarda devam etmemesi ekteki örnekte kişi sayısının 24 şubat dahil devam etmesi gerekiyor.

Allah'a razı olsun

Saygılarımla
 

Ekli dosyalar

Hocam sizin ilk gönderdiğiniz dosya ile bu gönderdiğiniz dosya aynı değil bundan dolayı hata verir. Dosyayı inceleyiniz. Ama dosyaya veri girişi yaptığınızda Dağıt makrosunu çalıştırmalısınız.
 

Ekli dosyalar

hocam aşağıdaki satır sorun verdi

kac = WorksheetFunction.Match(Range("E" & j), f.Range("B5:B9"), 0)
 
Muhammet Bey

''worksheetfunction sınıfının match özelliği alınamıyor'' hatası verdi
 
Hocam hiç bir sorun yok dosyada. Siz veri mi siliyorsunuz? Hatalı dosya bu mu? Ne gibi sorun var?
 
Ben 5 defa denedim yine de sorunla karşılaşmadım. Siz makroyu hangi sayfada çalıştırıyorsunuz?
 
Yok hocam veri silmedim vb den makroyu çalıştırıyorum daha önce yazdığım hatayı veriyor satırı sarıya boyuyor.Acaba kullandığım excel den olabilirmi?
 
VBA'dan çalıştıryorsanız, Rezervasyon sayfası aktif olmalı.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst