AccessTr.neT

Tam Versiyon: Hücre Dolu İse Farklı Reklendir. ( Muaf)
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2
Merhabalar,

ekli dosyada değişiklik yapılmasında desteğinize ihtiyacım var. şimdiden teşekkürler.

Raporda yapılmasını istediğim data1 dosyasından tarihlerin karşısında bir (I sütunu) açıklama varsa ( dolu ise ) kargo saat dosyasında o tarihin farklı renklendirerek muaf sütununa yazması. örnek saat uyum dosyasında bulunmaktadır.

desteklerinizi talep ederim.

Saygılarımla.
Çalışmanız ile ilgili olarak yeterli açıklama yapmamışsınız, gün içinde çok yoğun tempo içerisinde sizlere de yardımcı olmaya çalışıyoruz ancak çalışmalarınız ile ilgili bizlerin fazla efor sarfetmeden anlaması için gerekli ve/veya kolaylık sağlayacak bilgileri paylaşmadığınız zaman bizler önce mantığı anlamaya, sonra sorunuzu yorumlamaya sonra çözüm geliştirmeye çalışmak zorunda kalıyoruz ki inanın buna ayıracak yeterli zamanımız yok. Sorularınıza hızlı, doğru cevaplar alabilmek için çalışmanızın nasıl kurgulandığını, nasıl işlediğini, ne yapılınca ne sonuç alındığını ve ne yapmak istediğinizi ve takıldığınız noktaları daha net ifade edin, yardımcı olmaya çalışalım.


Not: Sorunuz Excel ile alakalı Access bölümünde açmışsınız, tarafımca ilgili bölüme taşınmıştır. Doğru ve zamanında cevaplar alabilmek için doğru bölümde konu açmaya özen gösterin.
merhabalar,

@atoykan hocam öncelikle siz ve nezdinizde destek sağlayan hacalarımıza teşekkür ederim.

data1, verilerin günlük kayıt edildiği müşteri, müşteri hedef teslim saati vs. (taşıma firmasına verilen hedef teslim her müşteri için sabittir) tutulduğu dosyadır.

kargo saat kontrol dosyasından tarih aralıkları girilerek data1 (kapalı halde) dosyasından gerçekleşen veriler tarih bazlı çekilmektedir. 

kargo saat kontrol dosyasına gelen bilgilerde, eğer o güne ait saat hedef teslim saatten büyükse kırmızı, eşit/küçükse yeşil olarak renklendirmektedir. yeşil olarak renkler zamanında kabul edilip zamanında sütununa, kırmızı olanlar geç kabul edilip geç teslim edildi sütununda müşterinin karşısına gelen hücrelere toplama (hesaplama) yapmaktadır.  

toplam kısmında girilen tarih aralığında müşteriye yapılan toplam teslimattır. zamanın da toplam bölünerek, zamanında teslimat oranı hesaplanmaktadır.

Müşteriye geç teslim olan durumlarda mücbir neden oluyor trafik kazası, araç arızası vs.  yardıma ihtiyaç duyduğum durum data1 dosyasında teslimatın gerçekleştiği tarihte I sütunun da müşterinin karşısına denk gelen hücrede açıklama varsa ( dolu ise) o tarihte eğer ortalama teslim zamanı, hedef teslim saatinden büyükse kargo saat kontrol dosyasında o tarihi farklı renklendirerek (örnk gri) kaç muaf sütunda müşterinin karşısına gelen hücreye hasaplama yapması.  ( toplam teslimata yine dahil olacak şekilde)

umarım anlatabilmişimdir. dosyada da görsel olarak anlatmaya çalışmıştım.

Saygılarımla...
kodu aşağıdakiyle değiştirip dener misiniz?
Sub xVeriAl(TrhBas As Long, TrhBit As Long)
Application.ScreenUpdating = False
Dim KykSyf As String: KykSyf = "Data"
Dim HdfSyf As String: HdfSyf = "Saat Bazlı Uyum"
Dim Sql As String
Dim ADO_CN As Object

SQLGrp = "SELECT (" & _
"trim([Data$].Kargo) & '|' & " & _
"trim([Data$].Rota) & '|' & " & _
"trim([Data$].Sehir) & '|' & " & _
"trim([Data$].AlacakDepo) & '|' & " & _
"trim([Data$].MagazaAdi) & '|' & " & _
"Format([HedefTeslimSaati],'HH:mm')) as xKey,'','','','',''," & _
"Sum(IIf([Data$].[HedefTeslimSaati]>=[Data$].[OrtalamaTeslimAlmaZamanı],1,0)) AS Zamanında, " & _
"Sum(IIf([Data$].[HedefTeslimSaati]<[Data$].[OrtalamaTeslimAlmaZamanı],1,0)) AS Geç, " & _
"Sum(IIf(len([Data$].[Açıklama] & '' )>0,1,0)) AS Muaf, " & _
"Sum(1) AS Toplam, " & _
"Sum(IIf([Data$].[HedefTeslimSaati]>=[Data$].[OrtalamaTeslimAlmaZamanı],1,0))/Sum(1) AS Oran, " & _
"format(Sum(IIf([Data$].[HedefTeslimSaati]<[Data$].[OrtalamaTeslimAlmaZamanı],[Data$].[OrtalamaTeslimAlmaZamanı]-[Data$].[HedefTeslimSaati],0))/Sum(IIf([Data$].[HedefTeslimSaati]<[Data$].[OrtalamaTeslimAlmaZamanı],1,0)),'hh:mm') & ' dk' AS OrtGec, " & _
"iif(Sum(IIf([Data$].[HedefTeslimSaati]<[Data$].[OrtalamaTeslimAlmaZamanı],[Data$].[OrtalamaTeslimAlmaZamanı]-[Data$].[HedefTeslimSaati],0))/Sum(IIf([Data$].[HedefTeslimSaati]<[Data$].[OrtalamaTeslimAlmaZamanı],1,0))> 31*1/(24*60),'Hayır','Evet' ) AS Kabul " & _
"FROM [Data$] " & _
"WHERE ((([Data$].TeslimTarih) >= " & TrhBas & " And ([Data$].TeslimTarih) <= " & TrhBit & ")) " & _
"GROUP BY [Data$].Kargo, [Data$].Rota, [Data$].Sehir, [Data$].AlacakDepo, [Data$].MagazaAdi, Format([HedefTeslimSaati],'HH:mm');"

SQLTek = "SELECT (trim([Data$].Kargo) & '|' & trim([Data$].Rota) & '|' & trim([Data$].Sehir) & '|' & trim([Data$].AlacakDepo) & '|' & trim([Data$].MagazaAdi) & '|' & Format([HedefTeslimSaati],'HH:mm')) as xKey," & _
"clng([Data$].TeslimTarih), Format([OrtalamaTeslimAlmaZamanı],'HH:mm') " & _
"FROM [Data$] " & _
"WHERE ((([Data$].TeslimTarih) >= " & TrhBas & " And ([Data$].TeslimTarih) <= " & TrhBit & ")) "

Set ADO_CN = CreateObject("Adodb.Connection")

yol = ThisWorkbook.Path & "\Data1.xlsx"

ADO_CN.connectionstring = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & yol & _
";extended properties=""excel 12.0;hdr=yes"""
ADO_CN.Open

Set ADO_RSGrp = ADO_CN.Execute(SQLGrp)
Set ADO_RSTek = ADO_CN.Execute(SQLTek)

With ThisWorkbook.Sheets(HdfSyf)
If .AutoFilterMode = True Then .AutoFilter.ShowAllData
.UsedRange.Offset(1).Clear
.UsedRange.Offset(, 13).Clear

.Range("a2").CopyFromRecordset ADO_RSGrp
SonStr = .Cells(.Rows.Count, 1).End(xlUp).Row

If SonStr < 2 Then
MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"
GoTo son
End If

Dim dic As Object
Dim DzDgr As Variant

Set dic = CreateObject("Scripting.Dictionary")
DzKey = .Range("A2:A" & SonStr).Value2
ReDim DzDgr(1 To UBound(DzKey), 5)
For Each itm In DzKey
If Not dic.Exists(itm) Then 'Anahtar var mı?
dic.Add itm, dic.Count 'dizi özelliğinde değer ekleme
tmpDgr = Split(itm, "|")
For xTD = 0 To 5
DzDgr(dic.Count, xTD) = tmpDgr(xTD)
Next xTD
End If
Next itm
DzTek = ADO_RSTek.GetRows

Dim DzTrh As Variant
ReDim DzTrh(0 To dic.Count, TrhBas To TrhBit)
'Get Upper and Lower Bounds
maxX = UBound(DzTek, 2)
minX = LBound(DzTek, 2)
maxY = UBound(DzTek, 1)
minY = LBound(DzTek, 1)
For x = TrhBas To TrhBit
DzTrh(0, x) = Format(x, "dd.mm.yyyy")
Next x
For x = minX To maxX
xStr = dic(DzTek(0, x)) + 1
xStn = DzTek(1, x)
DzTrh(xStr, xStn) = DzTek(2, x)
Next x

.Range("a2").Resize(dic.Count, 6) = DzDgr
.Range("N1").Resize(dic.Count + 1, TrhBit - TrhBas + 1) = DzTrh
.Cells(1, 1).EntireRow.Font.Bold = True
.Cells(1, 1).EntireRow.VerticalAlignment = xlBottom
.Cells(1, 1).EntireRow.HorizontalAlignment = xlCenter
.Range("A1:F1").WrapText = True
.Range("A1:F1").VerticalAlignment = xlCenter
.Range(.Cells(1, 7), .Cells(1, TrhBit - TrhBas + 14)).Orientation = xlUpward
.Range("K:K").NumberFormat = "0.%"
' .Range("K:K").NumberFormat = "hh:mm;@"

End With
son:
ADO_RSGrp.Close
ADO_CN.Close
Set ADO_RSGrp = Nothing
Set ADO_CN = Nothing
xRenkli 'xRenkli yordamı çağrılıyor
Application.ScreenUpdating = True

End Sub
yapılan değişiklikler
1 - Muaf alanı için hesaplama satırı eklendi
"Sum(IIf(len([Data$].[Açıklama] & '' )>0,1,0)) AS Muaf, "
2 - I sütunu eklendiğinden silme ve hücre biçimlendirme işlemlerindeki sütunlar ıdan itibaren 1 tane kaydırıldı
Renklendirme koduna bakmadım büyük bir ihtimalle orada da sütun kaydırması yeterli olacaktır
Hayırlı günler @berduş hocam,

kod muaf hesaplama oldu, teşekkür ederim.

atladığım bir konu da ve renklendirmede eksik var. sütun kaydırmak yeterli olamadı, kırmızı olarak renklendirildiği için geç olarakta hesaplanıyor. yardımcı olabilirseniz çok sevinirim.

I sütununda müşterinin karşısına denk gelen hücrede açıklama varsa ( dolu ise) o tarihte eğer ortalama teslim zamanı hedef teslim saatinden büyükse kargo saat kontrol dosyasında o tarihi farklı renklendirmesi. ( örnk: gir/ sizin belirleyeceğiniz uygun renk olabilir) renklendirme "kabul edilebilir gecikme süre" başlığından sonra yapıla bilir m?

diğer konu atladığım konu ise:

toplam kısmı zamanında+ geç kısımlarını hesaplıyor. bir başlık daha ekleyerek zamanın+geç+muaf= toplamteslimatgün. 2. görselde olduğu gibi. 

tekrar destekleriniz için teşekkürler.
Sayfalar: 1 2