Soru Tarih Aralığı Veri Getirme

[valentino06]

Merhaba;
Arkadaşlar Aylık sayfasında "E,F"sütünlarındaki formulle iki tarih arası verileri getiriyorum.bu formülleri makro ile ve Stok kodu, malzeme grubu cinsi ile bu iki sütunu makro ile getirme olasılığımız olabilirmi siz değerli hocalarımdan yardımlarınızı bekliyorum. ürün sayısı çok fazla olduğundan dolayı sayfa içinde koda göre ve ürüne göre arama yaptırmak istiyorum. çok teşekkür ederim.

 

[valentino06]

Arkadaşlar yardımlarınızı bekliyorum. Çok teşekkür ederim.

 

[Ziynettin]

Sub test()
Dim a(), b(), c(), d As Object
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet

Set s1 = Sheets("Giren")
Set s2 = Sheets("Çıkan")
Set s3 = Sheets("Stok")
Set s4 = Sheets("Aylık")

Set d = CreateObject("scripting.dictionary")

son1 = s1.Cells(Rows.Count, 2).End(3).Row
a = s1.Range("B2:G" & son1).Value  ' Giren

son2 = s2.Cells(Rows.Count, 2).End(3).Row
b = s2.Range("B2:J" & son2).Value  ' Çıkan

son3 = s3.Cells(Rows.Count, 2).End(3).Row
st = s3.Range("B2:E" & son3).Value  ' Stok

t1 = CDate(s4.[K1])
t2 = CDate(s4.[K2])

y = UBound(st)
ReDim c(1 To y, 1 To 10)

For i = 1 To UBound(st)
    If Not IsEmpty(st(i, 4)) Then
        If d.exists(st(i, 1)) Then
            sat = d(st(i, 1))
        Else
            d(st(i, 1)) = d.Count + 1
            sat = d.Count
            c(sat, 1) = sat
            c(sat, 2) = st(i, 1)
            c(sat, 3) = st(i, 3)
        End If
        c(sat, 5) = st(i, 4)
        c(sat, 8) = st(i, 4)
    End If
Next i

For i = 1 To UBound(a)
    If a(i, 1) >= t1 And a(i, 1) <= t2 Then
        If d.exists(a(i, 2)) Then
            sat = d(a(i, 2))
        Else
            d(a(i, 2)) = d.Count + 1
            sat = d.Count
            c(sat, 1) = sat
            c(sat, 2) = a(i, 2)
            c(sat, 3) = a(i, 4)
        End If
        c(sat, 6) = c(sat, 6) + a(i, 5)
        c(sat, 8) = c(sat, 5) + c(sat, 6)
    End If
Next i

For i = 1 To UBound(b)
    If b(i, 1) >= t1 And b(i, 1) <= t2 Then
        If d.exists(b(i, 2)) Then
            sat = d(b(i, 2))
        Else
            d(b(i, 2)) = d.Count + 1
            sat = d.Count
            c(sat, 1) = sat
            c(sat, 2) = b(i, 2)
            c(sat, 3) = b(i, 4)
        End If
        c(sat, 7) = c(sat, 7) + b(i, 8)
        c(sat, 8) = c(sat, 5) + c(sat, 6) - c(sat, 7)
    End If
Next i

s4.Range("A2:H" & Rows.Count) = Empty

If d.Count > 0 Then
    s4.[A2].Resize(d.Count, 8) = c
End If

End Sub

 

[valentino06]

Sayın Ziynettin Bey çok teşekkür ederim. ellerinize sağlık rica etsem aylık sayfasına 2 Adet Arama texbox koyabilirmiyiz. koda göre, malzeme grup cinsine göre süzme yapılabilirmi vba ile lütfen yardımcı olabilirmisiniz.

 

[Ziynettin]

Tarih aralığında mı olacak?

 

[valentino06]

Aylık sayfasında 2 adet texbox koyabilirmisin. 1. texbox stok koduna göre süzme işlemi yapsın. diğer texbox ta malzeme grub cinsine göre yapsın. yeter. aradığımız hızlı bir şekilde bulmak için.

 

[Ziynettin]

Soruyu umarım eksik anlamadım.

 

[valentino06]

Sayın Ziynettin Bey çok teşekkür ederim. ellerinize sağlık Allah Kat Kat Razı Olsun.