• DİKKAT

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

S.K.T TAKİP LİSTEM İÇİN YARDIM

Katılım
16 Nisan 2020
Mesajlar
19
Excel Vers. ve Dili
İngilizce
Merhaba,

Aşağıda ekte bıraktığım excel dosyasında ilaçların skt tarihlerini takip edeceğim. Sekmelerde bulunan listelerde tarihi yaklaşan ilaçları anasayfada nasıl gösterebilirim? Yardımlarınız için şimdiden teşekkürler,
 

Ekli dosyalar

Ekli dosyayı inceleyiniz.
 

Ekli dosyalar

Ellerine sağlık @YUSUF44 çok güzel bir çalışma olmuş. Çok çok teşekkür ederim. Umarım çok zamanınızı almamıştır
 
Bende benzer bir uygulama arıyordum. teşekkür ederim benimde işimi çözdü.
 
@YUSUF44 hocam şimdi ben alttaki sekmelere bir sütun ekledim. Koduda ona göre düzenlediğimi düşünüyorum, ancak ana sayfaya getiremedim. İşin içindende çıkamadım, beynim yanık şuan. Son halini ekte paylaşıyorum. Kod ise aşağıdaki gibi düzenledim;

If Sheets(i).Name = "PM" Or Sheets(i).Name = "PS" Or Sheets(i).Name = "PX" Or Sheets(i).Name = "PL2" Or _
Sheets(i).Name = "PL" Or Sheets(i).Name = "PS2" Then
If WorksheetFunction.CountIf(Sheets(i).[H9:H39], "SKT YAKLAŞTI") > 0 Then
yeni = s1.Cells(Rows.Count, "N").End(3).Row + 1

sorgu = "select F1 from[" & Sheets(i).Name & "$C9:H39] where F6='SKT YAKLAŞTI'"
Set rs = con.Execute(sorgu)
s1.Range("N" & yeni).CopyFromRecordset rs
son = s1.Cells(Rows.Count, "N").End(3).Row
s1.Range("L" & yeni & ":L" & son) = Sheets(i).Name

sorgu = "select F2 from[" & Sheets(i).Name & "$C9:H39] where F6='SKT YAKLAŞTI'"
Set rs = con.Execute(sorgu)
s1.Range("R" & yeni).CopyFromRecordset rs

sorgu = "select F2 from[" & Sheets(i).Name & "$C9:H39] where F6='SKT YAKLAŞTI'"
Set rs = con.Execute(sorgu)
s1.Range("S" & yeni).CopyFromRecordset rs

sorgu = "select F3 from[" & Sheets(i).Name & "$C9:H39] where F6='SKT YAKLAŞTI'"
Set rs = con.Execute(sorgu)
s1.Range("U" & yeni).CopyFromRecordset rs

sorgu = "select F4 from[" & Sheets(i).Name & "$C9:H39] where F6='SKT YAKLAŞTI'"
Set rs = con.Execute(sorgu)
s1.Range("Y" & yeni).CopyFromRecordset rs
 

Ekli dosyalar

@YUSUF44 hocam şimdi ben alttaki sekmelere bir sütun ekledim. Koduda ona göre düzenlediğimi düşünüyorum, ancak ana sayfaya getiremedim. İşin içindende çıkamadım, beynim yanık şuan. Son halini ekte paylaşıyorum. Kod ise aşağıdaki gibi düzenledim;

If Sheets(i).Name = "PM" Or Sheets(i).Name = "PS" Or Sheets(i).Name = "PX" Or Sheets(i).Name = "PL2" Or _
Sheets(i).Name = "PL" Or Sheets(i).Name = "PS2" Then
If WorksheetFunction.CountIf(Sheets(i).[H9:H39], "SKT YAKLAŞTI") > 0 Then
yeni = s1.Cells(Rows.Count, "N").End(3).Row + 1

sorgu = "select F1 from[" & Sheets(i).Name & "$C9:H39] where F6='SKT YAKLAŞTI'"
Set rs = con.Execute(sorgu)
s1.Range("N" & yeni).CopyFromRecordset rs
son = s1.Cells(Rows.Count, "N").End(3).Row
s1.Range("L" & yeni & ":L" & son) = Sheets(i).Name

sorgu = "select F2 from[" & Sheets(i).Name & "$C9:H39] where F6='SKT YAKLAŞTI'"
Set rs = con.Execute(sorgu)
s1.Range("R" & yeni).CopyFromRecordset rs

sorgu = "select F2 from[" & Sheets(i).Name & "$C9:H39] where F6='SKT YAKLAŞTI'"
Set rs = con.Execute(sorgu)
s1.Range("S" & yeni).CopyFromRecordset rs

sorgu = "select F3 from[" & Sheets(i).Name & "$C9:H39] where F6='SKT YAKLAŞTI'"
Set rs = con.Execute(sorgu)
s1.Range("U" & yeni).CopyFromRecordset rs

sorgu = "select F4 from[" & Sheets(i).Name & "$C9:H39] where F6='SKT YAKLAŞTI'"
Set rs = con.Execute(sorgu)
s1.Range("Y" & yeni).CopyFromRecordset rs
çözdüm hocam, çok basitmiş aslında da işte körlük mü diyim dikkatsizlik mi:)
 
Merhaba

Ekte paylaştığım son güncel excel dosyasında STOK_İLAÇ sekmesinde diğer sekmelerde bulunan ilaçların toplam adedini ve bugüne en yakın son kullanma tarihini getirmek istiyorum. Toplama kısmını çözdüm, ama birim değerini ( kutu&adet ) ve tarih kısmını çözemedim. Örnek olarak Dikloron ampul değerini yazdım. Formülü belirledikten sonra diğer ilaçlar için formül veya makro hazırlayabilirim. Desteklerinizi rica ederim,

Saygılarımla,
 

Ekli dosyalar

Geri
Üst