• DİKKAT

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

TOPLA.ÇARPIM üzerine iddialı bir soru

H

HAKANP

Katılım
17 Nisan 2006
Mesajlar
228
öncelikle, herkesin yeni yılı kutlu olsun.

Başlıkta iddialı dedim, bence çok iddialı gerçekten.

Gelelim konuya:

Ekte vermiş olduğum Çalışma kitabında "24.12.2008" isimli çalışma sayfasındaki veriler kaynak kabul edilerek. "Genel" isimli çalışma sayfasına, koşullu toplam ve TOPLA.ÇARPIM fonksiyonları yardımı ile icmal türünden bir tablo oluşuyor. Sayfalara ileride "25.12.2008","26.12.2008",..... şeklinde sürekli yenileri eklenecek. Zaten " Genel " sayfasının hücerelerindeki fonksiyonlara bakarsak tarih kriteri " E2 " hücresinden alınmakta.
Buraya kadar tablonun çalışmasında bir sıkıntı yok.
Ancak yapmak istediğimiz fantezi, " Genel " sayfasının, C,E,G,I,.... sütünlarına gelen kişi sayılarının bulunduğu hücrelere, kişilerin isimlerini açıklama olarak alt alta eklemek. Tarih değiştikçe yada ilgili tarihin sayfasında değişiklikler yapıldıkça, eklenen açıklamalarda kendini hemen güncelleyecek.


Fantezimiz, ekli dosyada örneklenmiştir.

Şimdiden başarılar.
 

Ekli dosyalar

Son düzenleme:
Merhaba

Bahsettiğiniz kadar fantezi değil, ancak bu işlemerde kod yazılırken hazırlayacağınız tablo ve diğer içeriklerinde dikkatli ve düzenli olmasına özen gösterirseniz hiçde yapılamayacak bir şey değil isteğiniz.

Göndermiş olduğunuz ek dosyadaki mevcut veriler ile birşeyler yapmaya hazırladım.
Ek dosyayı inceleyiniz..
 

Ekli dosyalar

Süper olmuş teşekkür ederim.
Yazılan kodlardan anladığım üzere, siz vardiya saatlerine göre kodları oluşturmuşsunuz, bana göre bu daha karmaşık bir hal almış oysaki, düzenlemeyi vardiya kodları göre yapsaydınız, HT, Yİ,R .... gibi kriterlere göre kodlar daah isabetli çalışabilirdi. Zaten tabloda icmal oluşturulurken de formüllerde " Vardiya kodları baz alındı"
Variyalar ve kodlar aşağıdaki gibidr.
08:00 / 16:00 -1
08:00 / 18:00 -2
16:00 / 24:00 -3
24:00 / 08:00 -4
08:00 / 20:00 -5
20:00 / 08:00 -6
12 SAATTEN FAZLA -7
RAPOR -R
Y.İZİN -Yİ
H.T. -HT
DİĞER -D

Yalnız, bir şey fark ettim yada iyileştirme adına bir öneri diyebilirim. Açıklama pencerelerine gelen isim sayısı 3'den fazla olunca, açıklama penceresinde görünmüyor. Açıklama pencere boyutlarının isimlerin uzunluklarına ve isim sayısına göre, yeniden kendini ayarlacayakk hale getirilmesinin daha şık olacağı düşüncesindeyim
 
Son düzenleme:
HAKANP' Alıntı:
Süper olmuş teşekkür ederim.
Yazılan kodlardan anladığım üzere, siz vardiya saatlerine göre kodları oluşturmuşsunuz, bana göre bu daha karmaşık bir hal almış oysaki, düzenlemeyi vardiya kodları göre yapsaydınız, HT, Yİ,R .... gibi kriterlere göre kodlar daah isabetli çalışabilirdi...
Genişletmek için tıkla ...

Tekrar Merhaba,

Siz ne yapmak istediğinizi, hangi veriyi nerden ve nasıl çekmek istediğinizi biliyorsunuz. Oysa ben bilmiyorum. Ben sadece böyle bir çalışma yapılıp yapılamayacağı konusundaki düşüncelerinize örnek olarak yollamış olduğunuz ek dosyaya bakıp nasıl bir sonuca gidebilirimin küçük bir örneklemesini yapmaya çalıştım. Tabiiki bu, daha basit ve sade bir biçime dönüştürülebilir. Ama dediğim gibi bunun için önce neler yapılmasını bilmek lazım.

Çalışmayı siz biliyorsunuz. Vardiya kodları diyorsunuz. Ben bunları bilmiyordum mesela...
 
Önce anlatım bozukluğu için özür dilerim.
Anladım ben şimdi size bir dosya daha ekleyeceğim. Genel sayfasında vardiyaların üzerlerine vardiya kodlarını yazdım.
Genel tablosundaki kişi sayısı verileri tarih sayfasında el ile girilen vardiya kodları saydırılarak getiriliyor. İsimlerini getirmek size kalmış, eğer açıklama ekleme olayında, vardiya kodlarını baz alırsak tablo sağlıklı çalışacaktır.

Daha önce belirttiğim gibi Açıklama pencerelerine gelen isim sayısı 3'den fazla olunca, açıklama penceresinde görünmüyor. Açıklama pencere boyutlarının isimlerin uzunluklarına ve isim sayısına göre, yeniden kendini ayarlacayak hale getirilmesinin daha şık olacağı düşüncesindeyim
(Ekleyeceğiniz dosyaların uzantısı mutlaka .xls olmalı rar,zip filitreye takılıyor)
Şimdiden teşekkürler.
 

Ekli dosyalar

Son düzenleme:
Kodu kendim çözdüm galiba, siz sadece gelen isim sayısına göre açıklama penceresini resize etmeyi bir halletseniz.
 
Son düzenleme:
Merhaba,
Ek dosyayı inceleyiniz..

Kod: 
Sub ekle()
Dim hcr As Range, hcr2 As Range, vrd As Range, syf As String, sayfa As Worksheet
Sheets(2).Range("c6:t9").ClearComments
For i = 6 To 9
syf = Sheets("genel").Range("E2")
For Each sayfa In Worksheets
If sayfa.Name <> syf Then GoTo son
    Set hcr = Sheets(2).Cells(i, 2)
    For Each hcr2 In Sheets(syf).Range("K7:K" & Sheets(1).[K65536].End(3).Row)
        If hcr2 = hcr Then
                With Sheets(2)
                    Select Case hcr2.Offset(0, 4)
                    Case Is = "1": ek1 = ek1 & Chr(10) & hcr2.Offset(0, -9).Text
                        .Cells(i, 3).ClearComments
                        .Cells(i, 3).AddComment.Shape.TextFrame.AutoSize = True
                        .Cells(i, 3).Comment.Text ek1
                    Case Is = "2": ek2 = ek2 & Chr(10) & hcr2.Offset(0, -9).Text
                        .Cells(i, 5).ClearComments
                        .Cells(i, 5).AddComment.Shape.TextFrame.AutoSize = True
                        .Cells(i, 5).Comment.Text ek2
                    Case Is = "3": ek3 = ek3 & Chr(10) & hcr2.Offset(0, -9).Text
                        .Cells(i, 7).ClearComments
                        .Cells(i, 7).AddComment.Shape.TextFrame.AutoSize = True
                        .Cells(i, 7).Comment.Text ek3
                    Case Is = "4": ek4 = ek4 & Chr(10) & hcr2.Offset(0, -9).Text
                        .Cells(i, 9).ClearComments
                        .Cells(i, 9).AddComment.Shape.TextFrame.AutoSize = True
                        .Cells(i, 9).Comment.Text ek4
                    Case Is = "5": ek5 = ek5 & Chr(10) & hcr2.Offset(0, -9).Text
                        .Cells(i, 11).ClearComments
                        .Cells(i, 11).AddComment.Shape.TextFrame.AutoSize = True
                        .Cells(i, 11).Comment.Text ek5
                    Case Is = "6": ek6 = ek6 & Chr(10) & hcr2.Offset(0, -9).Text
                        .Cells(i, 13).ClearComments
                        .Cells(i, 13).AddComment.Shape.TextFrame.AutoSize = True
                        .Cells(i, 13).Comment.Text ek6
                    Case Is = "7": ek7 = ek7 & Chr(10) & hcr2.Offset(0, -9).Text
                        .Cells(i, 15).ClearComments
                        .Cells(i, 15).AddComment.Shape.TextFrame.AutoSize = True
                        .Cells(i, 15).Comment.Text ek7
                    Case Is = "R": ekr = ekr & Chr(10) & hcr2.Offset(0, -9).Text
                        .Cells(i, 17).ClearComments
                        .Cells(i, 17).AddComment.Shape.TextFrame.AutoSize = True
                        .Cells(i, 17).Comment.Text ekr
                    Case Is = "Yİ": ekyi = ekyi & Chr(10) & hcr2.Offset(0, -9).Text
                        .Cells(i, 18).ClearComments
                        .Cells(i, 18).AddComment.Shape.TextFrame.AutoSize = True
                        .Cells(i, 18).Comment.Text ekyi
                    Case Is = "HT": ekht = ekht & Chr(10) & hcr2.Offset(0, -9).Text
                        .Cells(i, 19).ClearComments
                        .Cells(i, 19).AddComment.Shape.TextFrame.AutoSize = True
                        .Cells(i, 19).Comment.Text ekht
                    Case Is = "D": ekd = ekd & Chr(10) & hcr2.Offset(0, -9).Text
                        .Cells(i, 20).ClearComments
                        .Cells(i, 20).AddComment.Shape.TextFrame.AutoSize = True
                        .Cells(i, 20).Comment.Text ekd
                    End Select
                End With
        End If
    Next
    ek1 = "": ek2 = "": ek3 = "": ek4 = "": ek5 = "": ek6 = "": ek7 = "": ekr = "": ekyi = "": ekht = "": ekd = ""
GoTo devam
son:
Next
MsgBox "Rapor Baz Tarihli sayfa mevcut değildir. Lütfen Uygun bir Tarih yazınız..!", vbCritical, "TARİH HATASI"
Exit Sub
devam:
Next
Set hcr = Nothing
End Sub
 

Ekli dosyalar

Ben aşağıdaki gibi yazmıştım kodları

Sub ekle()
Dim hcr As Range, hcr2 As Range, ek As String, ek1 As String, ek2 As String, ek3 As String, ek4 As String
Sheets(2).Range("c5:t58").ClearComments ' Sheets(2)= genel, Sheets(1)= tarih.sayfası
For i = 1 To 5 ' i=kaç alan adı sayılacak
Set hcr = Sheets(2).Cells(i + 4, 2) ' hcr=geneldeki alan adı
For Each hcr2 In Sheets(1).Range("K7:K" & Sheets(1).[K65536].End(3).Row)
If hcr2 = hcr Then ' hcr2=tarih sayfasındaki alan adı
If hcr2.Offset(0, 4) = Sheets(2).Range("c4") And Sheets(2).Range("c3") = hcr2.Offset(0, -4) Then
ek = ek & Chr(10) & hcr2.Offset(0, -9).Text
Sheets(2).Cells(i + 4, 3).ClearComments
Sheets(2).Cells(i + 4, 3).AddComment
Sheets(2).Cells(i + 4, 3).Comment.Text Text:=Application.UserName & Chr(10) & ek
ElseIf hcr2.Offset(0, 4) = Sheets(2).Range("e4") And Sheets(2).Range("c3") = hcr2.Offset(0, -4) Then
ek1 = ek1 & Chr(10) & hcr2.Offset(0, -9).Text
Sheets(2).Cells(i + 4, 5).ClearComments
Sheets(2).Cells(i + 4, 5).AddComment
Sheets(2).Cells(i + 4, 5).Comment.Text Text:=Application.UserName & Chr(10) & ek1
ElseIf hcr2.Offset(0, 4) = Sheets(2).Range("g4") And Sheets(2).Range("c3") = hcr2.Offset(0, -4) Then
ek2 = ek2 & Chr(10) & hcr2.Offset(0, -9).Text
Sheets(2).Cells(i + 4, 7).ClearComments
Sheets(2).Cells(i + 4, 7).AddComment
Sheets(2).Cells(i + 4, 7).Comment.Text Text:=Application.UserName & Chr(10) & ek2
ElseIf hcr2.Offset(0, 4) = Sheets(2).Range("i4") And Sheets(2).Range("c3") = hcr2.Offset(0, -4) Then
ek3 = ek3 & Chr(10) & hcr2.Offset(0, -9).Text
Sheets(2).Cells(i + 4, 9).ClearComments
Sheets(2).Cells(i + 4, 9).AddComment
Sheets(2).Cells(i + 4, 9).Comment.Text Text:=Application.UserName & Chr(10) & ek3
ElseIf hcr2.Offset(0, 4) = Sheets(2).Range("k4") And Sheets(2).Range("c3") = hcr2.Offset(0, -4) Then
ek4 = ek4 & Chr(10) & hcr2.Offset(0, -9).Text
Sheets(2).Cells(i + 4, 11).ClearComments
Sheets(2).Cells(i + 4, 11).AddComment
Sheets(2).Cells(i + 4, 11).Comment.Text Text:=Application.UserName & Chr(10) & ek4
ElseIf hcr2.Offset(0, 4) = Sheets(2).Range("m4") And Sheets(2).Range("c3") = hcr2.Offset(0, -4) Then
ek5 = ek5 & Chr(10) & hcr2.Offset(0, -9).Text
Sheets(2).Cells(i + 4, 13).ClearComments
Sheets(2).Cells(i + 4, 13).AddComment
Sheets(2).Cells(i + 4, 13).Comment.Text Text:=Application.UserName & Chr(10) & ek5
ElseIf hcr2.Offset(0, 4) = Sheets(2).Range("o4") And Sheets(2).Range("c3") = hcr2.Offset(0, -4) Then
ek6 = ek6 & Chr(10) & hcr2.Offset(0, -9).Text
Sheets(2).Cells(i + 4, 15).ClearComments
Sheets(2).Cells(i + 4, 15).AddComment
Sheets(2).Cells(i + 4, 15).Comment.Text Text:=Application.UserName & Chr(10) & ek6
ElseIf hcr2.Offset(0, 4) = Sheets(2).Range("q4") And Sheets(2).Range("c3") = hcr2.Offset(0, -4) Then
ek7 = ek7 & Chr(10) & hcr2.Offset(0, -9).Text
Sheets(2).Cells(i + 4, 17).ClearComments
Sheets(2).Cells(i + 4, 17).AddComment
Sheets(2).Cells(i + 4, 17).Comment.Text Text:=Application.UserName & Chr(10) & ek7
ElseIf hcr2.Offset(0, 4) = Sheets(2).Range("r4") And Sheets(2).Range("c3") = hcr2.Offset(0, -4) Then
ek8 = ek8 & Chr(10) & hcr2.Offset(0, -9).Text
Sheets(2).Cells(i + 4, 18).ClearComments
Sheets(2).Cells(i + 4, 18).AddComment
Sheets(2).Cells(i + 4, 18).Comment.Text Text:=Application.UserName & Chr(10) & ek8
ElseIf hcr2.Offset(0, 4) = Sheets(2).Range("s4") And Sheets(2).Range("c3") = hcr2.Offset(0, -4) Then
ek9 = ek9 & Chr(10) & hcr2.Offset(0, -9).Text
Sheets(2).Cells(i + 4, 19).ClearComments
Sheets(2).Cells(i + 4, 19).AddComment
Sheets(2).Cells(i + 4, 19).Comment.Text Text:=Application.UserName & Chr(10) & ek9
ElseIf hcr2.Offset(0, 4) = Sheets(2).Range("T4") And Sheets(2).Range("c3") = hcr2.Offset(0, -4) Then
ek10 = ek10 & Chr(10) & hcr2.Offset(0, -9).Text
Sheets(2).Cells(i + 4, 20).ClearComments
Sheets(2).Cells(i + 4, 20).AddComment
Sheets(2).Cells(i + 4, 20).Comment.Text Text:=Application.UserName & Chr(10) & ek10
End If
End If
Next
ek = ""
ek1 = ""
ek2 = ""
ek3 = ""
ek4 = ""
ek5 = ""
ek6 = ""
ek7 = ""
ek8 = ""
ek9 = ""
ek10 = ""
Next
Set hcr = Nothing
End Sub
 
ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
.ScaleWidth 1.6, msoFalse, msoScaleFromTopLeft

1- Yalnız siz yazmış olduğunuz yukarıdaki kodda açıklama pencereleri sabitlemişsiniz.
Eğer ki açıklama pencereleri, gelen isim sayısı kadar boyutlanırsa daha şık olacaktır. Eğer 1 kişi gelecekse 1 kişi kadar boyut almalı, 10 kişi gelirse 10 kişi sığacak kadar boyut almalı ne eksik ne de fazla. Tabii genişlikte aynı şekilde.Açıklamadaki yazı genişliği ve uzunluğu otomatik sığdırılacak


2-For Each hcr2 In Sheets(1).Range("K7:K" & Sheets(1).[K65536].End(3).Row)
Bu kodda ise " Sheets(1) " tanımıda sayfa ismi ile tanımlanmalı. Ben Genel sayfasında verileri " E2" hücresinden baz aldırarak getirtiyorum. Eğer bu alanıda seçmeli hale getirebilirsek güzel olacaktır.
Teşekkürler
 
Son düzenleme:
HAKANP' Alıntı:
ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
.ScaleWidth 1.6, msoFalse, msoScaleFromTopLeft

1- Yalnız siz yazmış olduğunuz yukarıdaki kodda açıklama pencereleri sabitlemişsiniz.
Eğer ki açıklama pencereleri, gelen isim sayısı kadar boyutlanırsa daha şık olacaktır. Eğer 1 kişi gelecekse 1 kişi kadar boyut almalı, 10 kişi gelirse 10 kişi sığacak kadar boyut almalı ne eksik ne de fazla. Tabii genişlikte aynı şekilde.Açıklamadaki yazı genişliği ve uzunluğu otomatik sığdırılacak


2-For Each hcr2 In Sheets(1).Range("K7:K" & Sheets(1).[K65536].End(3).Row)
Bu kodda ise " Sheets(1) " tanımıda sayfa ismi ile tanımlanmalı. Ben Genel sayfasında verileri " E2" hücresinden baz aldırarak getirtiyorum. Eğer bu alanıda seçmeli hale getirebilirsek güzel olacaktır.
Teşekkürler
Genişletmek için tıkla ...


Sheets(1) sayfa isminde tanımlanmalı =
Sheets(Sheets("Genel").Range("E2"))

Açıklama ebat ile ilgili otomatik boyutlandırmayı yapamadım.
 
Aşağıdakki kodda ilave edilen satır ve kodlar kırmızı olarak gösterilmiştir.

Kod: 
.................
Dim hcr As Range, hcr2 As Range, vrd As Range, [COLOR=red]syf As String[/COLOR]
Sheets(2).Range("c6:t9").ClearComments
For i = 6 To 9
[COLOR=red]syf = Sheets("genel").Range("E2")[/COLOR]
    Set hcr = Sheets(2).Cells(i, 2)
    [COLOR=red]For Each hcr2 In Sheets(syf).Range("K7:K" & Sheets(1).[K65536].End(3).Row)[/COLOR]
        If hcr2 = hcr Then
....................
....................
 
Ayhan Ercan' Alıntı:
Açıklama ebat ile ilgili otomatik boyutlandırmayı yapamadım.
Genişletmek için tıkla ...

HAKANP' Alıntı:
:)
Herşey için çok teşekkür ederim.

Ben bunun için başlık açmayı düşünüyorum
Genişletmek için tıkla ...


Sevgili Recep İpek hocamın yardımlarıyla istemiş olduğunuz kodlar ve ek dosya bu başlığın 7 nolu mesajında güncellenmiştir.

Recep İpek hocamada katkılarından dolayı teşekkür ederim...
 
Ayhan Ercan' Alıntı:
Aşağıdakki kodda ilave edilen satır ve kodlar kırmızı olarak gösterilmiştir.

Kod: 
.................
Dim hcr As Range, hcr2 As Range, vrd As Range, [COLOR=red]syf As String[/COLOR]
Sheets(2).Range("c6:t9").ClearComments
For i = 6 To 9
[COLOR=red]syf = Sheets("genel").Range("E2")[/COLOR]
    Set hcr = Sheets(2).Cells(i, 2)
    [COLOR=red]For Each hcr2 In Sheets(syf).Range("K7:K" & Sheets(1).[K65536].End(3).Row)[/COLOR]
        If hcr2 = hcr Then
....................
....................
Genişletmek için tıkla ...

Bir istirhamım daha olacak sizlerden
Yukarıdaki kodda "E2" hücresine yazılan değer çalışma kitabındaki bir çalışma sayfasına denk geliyor. "E2" hücresine eğer yanlış birşey yazarsam ( olmayan sayfa ismi ) formüller ve makrolar hata veriyor.

Mevcut sayfanın koduna öyle bir kod yazmalıyım ki, "E2" hücresine yazılan değer, eğer çalışma kitabında olmayan bir sayfaya denk gelirse, formüller çalışmadan hata vermeli ve beni doğru sayfa ismi yazmaya mecbur etmeli. Taaki ben doğru bir sayfa ismi yazıncaya kadar
 
HAKANP' Alıntı:
Bir istirhamım daha olacak sizlerden
Yukarıdaki kodda "E2" hücresine yazılan değer çalışma kitabındaki bir çalışma sayfasına denk geliyor. "E2" hücresine eğer yanlış birşey yazarsam ( olmayan sayfa ismi ) formüller ve makrolar hata veriyor.

Mevcut sayfanın koduna öyle bir kod yazmalıyım ki, "E2" hücresine yazılan değer, eğer çalışma kitabında olmayan bir sayfaya denk gelirse, formüller çalışmadan hata vermeli ve beni doğru sayfa ismi yazmaya mecbur etmeli. Taaki ben doğru bir sayfa ismi yazıncaya kadar
Genişletmek için tıkla ...

Aynı mesajı (7 nolu mesaj) güncelledim.
İndirip deneyebilirisiniz...
 
Yardım........

Daha önce buradaki diğer arkadaşların yardımıyla burada bir tablo oluşturmuştuk. Aynı konu olduğu için yeniden bir başlık açmak istemedim.

Çalışma mantığı ise, tarih bazında firma çalışan kişilerin vardiyalara göre günlük durum raporu hazırlanmasıdır. Genel sayfasında ise ekle tuşuna bastığımızda kişi sayılarının bulunduğu hücrelere isimleri otomatik olarak açıklama şeklinde ekledik. Hatta açıklama pencerelerinin kişi sayılarına göre boyutlanmasını da başardık.

Ancak farklı bir durum oluştu. Biz dosyayı hazırladığımız zaman bir hücredeki kişi 15'i geçmiyor, açıklama penceresi görülebilir boyutta oluyordu. Şu anki durumda mecvutlar arttı ve bir bölümde çalışan sayısı 60'ı geçti. Açıklama penceresi artık ekrana sığmıyor :(

Yapmak istediğime gelince, ekle tuşuna basıldığı anda hücrelere kişi isimleri açıklama olarak eklenirken eğer sayı 15'i geçiyorsa, pencere sağ tarafa doğru genişlemeli, kişi sisimleri virgül yada "-" işareti ayrılarak 15'er kişiler sütunler gibi dizilmeli. Örneklemeyi ben yaptım. Ama makro içinde düzenleme yapacak kadar bilgiye sahip değilim :(

Yardımınıza ihtiyacım var.
 

Ekli dosyalar

2 gün bekledim yardımcı olacak kimse yok mu ? :(
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst