- Katılım
- 18 Nisan 2008
- Mesajlar
- 1,125
- Excel Vers. ve Dili
- office2010
Sayın Ziynettin merhaba,
A1'den seçilen malzemenin yıllardan birinde girişi yoksa program hata veriyor,
Örnek , A1'den Elma seçildi, ancak 2018 girişi yok, burada hata alıyorum.
Teşekkür ederim.
Kodda gerekli düzenleme yapıldı. Ayrıca A1'de ürün boş geçildiğin de iki tarih arasındaki verileri listeler.
Kod:
Sub veri_al()
Set s1 = Sheets("MALZEME_GİRİŞİ")
Set s2 = Sheets("GİRİŞ_KARŞILAŞTIRMA")
Z = TimeValue(Now)
a = s1.Range("B2:J" & s1.Cells(Rows.Count, 2).End(3).Row)
Dim tarih_1 As Date, tarih_2 As Date
s2.Range("A6:T" & Rows.Count).ClearContents
Ürün = s2.[A1]
sut = 1
For j = 1 To 20 Step 7
Set d = CreateObject("scripting.dictionary")
tarih_1 = s2.Cells(4, j + 1)
tarih_2 = s2.Cells(4, j + 2)
ReDim b(1 To UBound(a), 1 To 6)
For i = 1 To UBound(a)
If Ürün = "" Then GoTo atla
If a(i, 3) = Ürün Then
atla:
If a(i, 1) >= tarih_1 And a(i, 1) <= tarih_2 Then
If Not d.exists(a(i, 2)) Then
say = say + 1
d(a(i, 2)) = say
b(say, 1) = say
b(say, 2) = a(i, 2)
End If
sat = d(a(i, 2))
b(sat, 4) = b(sat, 4) + a(i, 5)
b(sat, 5) = b(sat, 5) + a(i, 9)
b(sat, 6) = b(sat, 5) / b(sat, 4)
End If
End If
Next i
On Error Resume Next
s2.Cells(6, sut).Resize(say, 6) = b
s2.Cells(4, sut + 3) = Application.Sum(Application.Index(b, , 4))
s2.Cells(4, sut + 4) = Application.Sum(Application.Index(b, , 5))
s2.Cells(4, sut + 5) = s2.Cells(4, sut + 4) / s2.Cells(4, sut + 3)
sut = sut + 7
say = 0
d.RemoveAll
Next j
MsgBox "İşleminiz bitti." & vbLf & vbLf & "İşlem süreniz: " & _
CDate(TimeValue(Now) - Z), vbInformation
End Sub
