bir malzemenin birden farklı fiyat-tarih... sorgulama

[modoste]

merhaba sayın hocalarım
ekli tabloma bir makro çözüm istemekteyim (Korhan hocam bu çalışmada makrolu çözümü kullanmam gerekiyo )

bu sorumu 7-8 sene önce formülle çözümleri olmuştu. ama bu sefer makrolu çözüm gerekli.

dosyamda sorumu ilettim açıkladım. bu tablo ile ilgili birden fazla sorum olacak bu ilki sayın hocalarım.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As Variant, X As Long, Sutun As Integer
    
    If Intersect(Target, Range("J3")) Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False
    
    Range("K3:XFD6").Clear
    ReDim Liste(1 To 4, 1 To 1000)
    Veri = Range("B4").CurrentRegion.Value

    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 2) = Target.Value Then
            Sutun = Sutun + 1
            Liste(1, Sutun) = Veri(X, 1)
            Liste(2, Sutun) = Veri(X, 4)
            Liste(3, Sutun) = Veri(X, 3)
            Liste(4, Sutun) = Veri(X, 5)
        End If
    Next

    If Sutun > 0 Then
        Range("K3").Resize(4, Sutun) = Liste
        Cells.Font.Name = "Tahoma"
        Cells.Font.Size = 7
        Columns.AutoFit
        Application.ScreenUpdating = True
    Else
        Application.ScreenUpdating = True
        MsgBox "Aranan malzeme bulunamadı!", vbCritical
    End If
End Sub

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırıp deneyiniz. J3 hücresini değiştirdiğinizde çalışır:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [J3]) Is Nothing Then Exit Sub
eskisut = WorksheetFunction.Max(Cells(3, Columns.Count).End(xlToLeft).Column, 11)
son = WorksheetFunction.Max(Cells(Rows.Count, "C").End(3).Row, 4)
Range(Cells(3, "K"), Cells(6, eskisut)).ClearContents
If Target = "" Then
    Exit Sub
ElseIf WorksheetFunction.CountIf(Range("C3:C" & son), Target) = 0 Then
    MsgBox Target & " ürününe ait herhangi bir veri bulunamadı!", vbInformation
Else
    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

    sorgu = "select F1 from[" & ActiveSheet.Name & "$B4:G" & son & "] where F2='" & Target & " '"
    Set rs = con.Execute(sorgu)
    If Not rs.EOF Then
        a = rs.GetRows
        [K3].Resize(UBound(a, 1) + 1, UBound(a, 2) + 1).Value = a
    End If
        sorgu = "select F4 from[" & ActiveSheet.Name & "$B4:G" & son & "] where F2='" & Target & " '"
    Set rs = con.Execute(sorgu)
    If Not rs.EOF Then
        a = rs.GetRows
        [K4].Resize(UBound(a, 1) + 1, UBound(a, 2) + 1).Value = a
    End If
    sorgu = "select F3 from[" & ActiveSheet.Name & "$B4:G" & son & "] where F2='" & Target & " '"
    Set rs = con.Execute(sorgu)
    If Not rs.EOF Then
        a = rs.GetRows
        [K5].Resize(UBound(a, 1) + 1, UBound(a, 2) + 1).Value = a
    End If
    sorgu = "select F5 from[" & ActiveSheet.Name & "$B4:G" & son & "] where F2='" & Target & " '"
    Set rs = con.Execute(sorgu)
    If Not rs.EOF Then
        a = rs.GetRows
        [K6].Resize(UBound(a, 1) + 1, UBound(a, 2) + 1).Value = a
    End If
End If
End Sub

 

[YUSUF44]

Şöyle daha güzel oldu sanki:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [J3]) Is Nothing Then Exit Sub
eskisut = WorksheetFunction.Max(Cells(3, Columns.Count).End(xlToLeft).Column, 11)
son = WorksheetFunction.Max(Cells(Rows.Count, "C").End(3).Row, 4)
Range(Cells(3, "K"), Cells(6, eskisut)).ClearContents
If Target = "" Then
    Exit Sub
ElseIf WorksheetFunction.CountIf(Range("C3:C" & son), Target) = 0 Then
    MsgBox Target & " ürününe ait herhangi bir veri bulunamadı!", vbInformation
Else
    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

    sorgu = "select F1,F4,F3,F5 from[" & ActiveSheet.Name & "$B4:G" & son & "] where F2='" & Target & " '"
    Set rs = con.Execute(sorgu)
    If Not rs.EOF Then
        a = rs.GetRows
        [K3].Resize(UBound(a, 1) + 1, UBound(a, 2) + 1).Value = a
    End If
End If
End Sub

 

[modoste]

Korhan hocamın ve Sayın YUSUF44 hocamın yazdığı makroları
kod görüntüle kopyala yapıştır yaptım ama ALT+F8 dediğimde kod çıkmadı. Hatam nerde.

 

[YUSUF44]

J3 hücresini değiştirdiğinizde çalışır:

Demiştim

Korhan Bey'in kodu da öyle.

 

[modoste]

çalıştıramadım hocam makroları anlayamadım sorunu
ALT+F11 / açılan pencereye kodu yapıştır dediken sonra ALT+F8 ile açılan makro penceresinde makro görünürdü. görünmedi sebep ne acaba

 

[Korhan Ayhan]

"Sub" ifadesi ile başlayan prosedürler genelde modül içine uygulanır.

"Private Sub Worksheet..." ifadesi ile başlayan prosedürler ise sayfanın kod bölümüne uygulanırlar.

"Private Sub Workbook..." ifadesi ile başlayan prosedürler ise kitabın kod bölümüne uygulanırlar.

Makrolar için bunlar önemli kavramlardır.

 

[modoste]

korhan hocam sizden ricam ekli dosya yapabilir misiniz
ben makro ile ilgili anlattıklarınızdan birşey anlayamadım bilgim az olduğundan

ya da benim makroyu neden çalıştırmadığımla ilgili (her zaman yaptığım şeyi yaptım ama olmadı) neresinde hata vardı

 

[YUSUF44]

Verdiğimiz kodlar sayfa olaylarına bağlı kodlardır ve belirttiğim gibi J3 hücresinin değişimine bağlıdır. Kodları sayfa adına sağ tıklayıp kod Görüntüle deyince açılan sayfaya yapıştırmalısınız. Bu kısma "sayfanın kod bölümü" denir. Sayfa olayları, hücre seçme, değişiklik yapma, yazdırma; kapatma, aktif etme, kaydetme, çift tıklama gibi olaylardır.

Kodu ekledikten sonra J3 hücresine istediğiniz ürünü yazarak sonucu gözlemleyin.

 

[YUSUF44]

İlave olarak bir sayfada aynı sayfa olayına bağlı sadece bir kod bloğu olabilir. Yani hem Korhan Bey'in hem de benim verdiğim kodlar Change olayına bağlı olduğu için aynı sayfaya eklememelisiniz. Eklerseniz hata verir.

 

[modoste]

o dediğinizi ilk yapmıştım hocam ekli dosyamdaki görünür sekmede sağ tıklayıp kod görüntüle dedikten sonra açılan pencereye kopyalamıştım ama öylede olmamıştı. şöyle olmadığını düşündüm. dosyayı makro olarak kaydettikten sonra yeniden açtığımda ALT+F8 dediğimde görememiştim.

 

[modoste]

2 ayrı makroyu tek dosyada yapmadım sayın YUSUF44
ben önce korhan hocamın makroyu sekme modüle kopyaladım. ama benim alıştığım bilgi Hep ALT+F8 ile açılan pencereden bir tane kod olurdu zaten. işte orda kodun adı görünmüyordu.

 

[YUSUF44]

Görünmez çünkü çalışması için sayfa olayı gerekir. Bahsettiğiniz makrolar sayfa olayına bağlı olmayıp manuel çalıştırılması gereken makrolardır.

 

[modoste]

şu anda korhan hocamın makroyu hocamın dediği gibi modüle kopyaladım ve hemen malzme adlarını değiştikçe çözümleri gördüm.
makroları iyi bilemediğimden benim acemiliğim. dediğim gibi ezberim şuydu
makroyu modüle kopyalacam sonra makro kaydedilen dosya olarak farklı kaydedecem. ve dosyayı açınca ALT+F8 diyecem sonra açılan listede makroyu görecem ve çalıştır diyecem

 

[Tevfik_Kursun]

Modoste Arkadaşım,
Buyrun; Soru, Soru2 ve Soru3 adlı sayfalarda hocaların çözümleri var.
İyi çalışmalar

 

[YUSUF44]

Eğer çalıştıysa modüle kopyalamamışsınızdır. Bu kavramları anlamak neye nasıl çözüm bulacağınızı kararlaştırmak için önemlidir.

 

[modoste]

Tevfik_Kursun un da çözümünü kullandım
tüm hocalarıma çok teşekkür ederim.
birazdan bu veri grubu ile ilgili diğer makrolu çözümü isteyecem

sorunun özeti şu;
A1 B1 C1 hücreleri olsun
FİYAT Başl. tarihi Bitiş Tarihi olsun
aci biber dediğimde 2,30 = 05.04.2011-05.04.2011
2,50 = 16.04.2011-30.04.2011 (16 nisanda, 21 nisanda, 24 nisanda, 30 nisanda fiyatın 2,50 tl olduğunu varsayıyorum)
şu an yazdığım örnekleme ilk tablomdaki veriler değildir.

 

[modoste]

sayın hocalarım
böyle bir veri listesine göre nasıl sonuçlar analizler çıkartılabilir (hocam kolaycılık olarak algılamayın topu size atmak gibi ama sizdeki matematiksel ve istatiksel analiz yeteneğiniz her zaman saygı duyduğum bir durumdur)
1- belirlenen bir malzemenin fiyatının hangi tarihlerde satın alındığı ve o tarihlerdeki fiyat ve tutarlarını ilk makroda yapıldı
2-belirlenen 2 tarih arasında yine seçilen bir malzemenin tarih ve fiyatları (ilk makro içine tarih kriteri konulacak galiba)
3-belirli bir tarih seçildiğinde o tarihten önceki son malzeme tarihi ve tutarı ve o tarihten sonraki ilk fiyatı ve tarihi yapılabilir. (patron soruyo mesela 11 mayısta neydi fiyatı dediği anda ben bir önceki ve bir sonrakini çabuk bulabilmem gerekiyo)

sadece malzeme adı - birim fiyatı ve o birim fiyata ait tarihlerle ilgili nasıl analizler yapılabilir. bu sorduklarım ve başkada olabilir.

 

[Korhan Ayhan]

Bu tarz analizler için Pivot Table (Özet Tablo) kullanabilirsiniz.

Hem kullanımı kolaydır ve hızlıdır. Kimseye ihtiyacınız olmadan kullanabilirsiniz. İstediğiniz gibi biçimlendirme yapabilirsiniz.