• DİKKAT

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

Veri Al, 2 Tarih Arası, Malzeme Seçimli

  • Konbuyu başlatan Konbuyu başlatan 1Al2Ver
  • Başlangıç tarihi Başlangıç tarihi
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
 
Sayın Ziynettin merhaba,

Zahmetleriniz ve ilginiz için bir kez daha teşekkür ederim,

Hayırlı sabahlar.

Saygılarımla.
 
Geri
Üst