Aylara göre SATILAN sayısını TextBox lara yazdırma

[sdegirmenci]

Merhaba; Ekli dosyamda Stok sayfasında D sütunundaki tarih aralıklarına bakarak örnek yukarıdaki yıla ait tarihler arasından 01.ocak 31 ocak arasındaki "M" Sütununda "SATILDI" sayısını UserForm üzerindeki "ocakyeni" kutusuna, 01.şubat 29 şubat arasındaki "SATILDI" Sayısını "şubatyeni" kutusuna yazdırmak istiyorum. Kod ile yada formül ile yapmak için çok uğraştım ancak başaramadım. bu konuda yardımcı olabirseniz çok sevinirim. Saygılarımla.

 

[Orion1]

Nisan ve mayıs aylarını yaptım.
Dosyanız ektedir.
Not: Değişken isimlerini ve nesne adlarında Türkçe karakterler kullanmayınız.
İngilizce windowsa geçtiğinizde veya İngilizce başka bir bilgisayarda hata verecektir.

Private Sub CommandButton1_Click()
'Nisan
Range("C4:M4").AutoFilter
Range("D4").AutoFilter field:=2, Criteria1:=">=" & CLng(CDate("01.04.2017")) _
, Operator:=xlAnd, Criteria2:="<=" & CLng(CDate("30.04.2017"))
Range("M4").AutoFilter field:=11, Criteria1:="SATILDI"
nisanyeni.Value = WorksheetFunction.Subtotal(3, Range("M4:M65536"))
'Mayıs
Range("C4:M4").AutoFilter
Range("D4").AutoFilter field:=2, Criteria1:=">=" & CLng(CDate("01.05.2017")) _
, Operator:=xlAnd, Criteria2:="<=" & CLng(CDate("31.05.2017"))
Range("M4").AutoFilter field:=11, Criteria1:="SATILDI"
mayısyeni.Value = WorksheetFunction.Subtotal(3, Range("M4:M65536"))
'Bitti.
Range("C4").AutoFilter

 

[numan şamil]

Merhaba
Geç kalmışım
Alternatif olsun

Private Sub CommandButton1_Click()
Dim a As Integer
Dim i, son As Long
son = [D65536].End(3).Row
Application.ScreenUpdating = False
    For i = 6 To son
    If yılyeni = Format(Range("D" & i), "yyyy") Then
If Range("D" & i) <> "" And Format(Range("D" & i), "mm") = 1 And Range("M" & i) = "SATILDI" Then
a = a + 1
End If
If Range("D" & i) <> "" And Format(Range("D" & i), "mm") = 2 And Range("M" & i) = "SATILDI" Then
b = b + 1
End If
If Range("D" & i) <> "" And Format(Range("D" & i), "mm") = 3 And Range("M" & i) = "SATILDI" Then
c = c + 1
End If
If Range("D" & i) <> "" And Format(Range("D" & i), "mm") = 4 And Range("M" & i) = "SATILDI" Then
d = d + 1
End If
If Range("D" & i) <> "" And Format(Range("D" & i), "mm") = 5 And Range("M" & i) = "SATILDI" Then
e = e + 1
End If
If Range("D" & i) <> "" And Format(Range("D" & i), "mm") = 6 And Range("M" & i) = "SATILDI" Then
f = f + 1
End If
If Range("D" & i) <> "" And Format(Range("D" & i), "mm") = 7 And Range("M" & i) = "SATILDI" Then
g = g + 1
End If
If Range("D" & i) <> "" And Format(Range("D" & i), "mm") = 8 And Range("M" & i) = "SATILDI" Then
h = h + 1
End If
If Range("D" & i) <> "" And Format(Range("D" & i), "mm") = 9 And Range("M" & i) = "SATILDI" Then
ı = ı + 1
End If
If Range("D" & i) <> "" And Format(Range("D" & i), "mm") = 10 And Range("M" & i) = "SATILDI" Then
j = j + 1
End If
If Range("D" & i) <> "" And Format(Range("D" & i), "mm") = 11 And Range("M" & i) = "SATILDI" Then
k = k + 1
End If
If Range("D" & i) <> "" And Format(Range("D" & i), "mm") = 12 And Range("M" & i) = "SATILDI" Then
l = l + 1
End If
End If
Next i
ocakyeni.Value = a
şubatyeni.Value = b
martyeni.Value = c
nisanyeni.Value = d
mayısyeni.Value = e
haziranyeni.Value = f
temmuzyeni.Value = g
ağustosyeni.Value = h
eylülyeni.Value = ı
ekimyeni.Value = j
kasımyeni.Value = k
aralıkyeni.Value = l
If ocakyeni.Value = 0 Then
ocakyeni.Value = ""
End If
Application.ScreenUpdating = True
End Sub

 

[numan şamil]

Merhaba
3 no lu mesajımdaki kodlar yılı da baz alması için güncellendi
Not:3 nolu mesajdaki ekli dosyanın kodlarını güncele meyi unutmuşum. yeni güncellendi.

 

[sdegirmenci]

Değerli Hocam Evren Gizlen ve Numan Şamil, ilginize çok teşekkür ederim. Kodları programıma uygulayacağım.Ayrıca Evren Hocam not olarak yazdığınız uyarıyı dikkate alacağım.Tekrar teşekkür ediyorum. İşleriniz kolay gelsin.Saygılarımla

 

[Orion1]

Değerli Hocam Evren Gizlen ve Numan Şamil, ilginize çok teşekkür ederim. Kodları programıma uygulayacağım.Ayrıca Evren Hocam not olarak yazdığınız uyarıyı dikkate alacağım.Tekrar teşekkür ediyorum. İşleriniz kolay gelsin.Saygılarımla

Rica ederim.
iyi çalışmalar.

 

[numan şamil]

İyi Çalışmalar