makro neden toplam işlemi yapmıyor

[metinavci23]

merhaba arkadaşlar.ekteki dosyadaki makro toplam işlemi yaptıramıyorum.biryerlerde hata yapıyorum ama anlayamadım nerde.yardımcı olursanız seinirim.şimdiden teşekür ederim

 

[Orion1]

Ekli dosyayı inceleyiniz.

Sub maddeler()
Dim ilktarih As Date, sontarih As Date
Set sv = Sheets("veritabani")
Set sm = Sheets("madde")
ilktarih = CDate(sm.Cells(2, 8))
sontarih = CDate(sm.Cells(4, 8))
sm.Cells(21, 16) = 0
For r = 3 To sv.[a65536].End(3).Row
If CDate(sv.Cells(r, "b")) >= ilktarih And CDate(sv.Cells(r, "b")) <= sontarih And Val(Left(sv.Cells(r, "g"), 3)) = sm.Cells(21, 3) Then
sm.Cells(21, 16).Value = sm.Cells(21, 16).Value + sv.Cells(r, "K").Value
End If
Next
Set sv = Nothing
Set sm = Nothing
End Sub

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki şekilde denermisiniz.

Sub Maddeler()
    Set SV = Sheets("veritabani")
    Set SM = Sheets("madde")
    İlk_Tarih = SM.Cells(2, 8)
    Son_Tarih = SM.Cells(4, 8)
    SM.Cells(21, 16) = 0
    For X = 3 To SV.[A65536].End(3).Row
    If SV.Cells(X, "B") >= &#304;lk_Tarih Or SV.Cells(X, "B") <= Son_Tarih And Left(SV.Cells(X, "G"), 3) = SM.Cells(21, 3) Then
    SM.Cells(21, 16) = SM.Cells(21, 16) + SV.Cells(X, "K")
    End If
    Next
    Set SV = Nothing
    Set SM = Nothing
    MsgBox "&#304;&#350;LEM&#304;N&#304;Z TAMAMLANMI&#350;TIR.", vbInformation
End Sub

 

[metinavci23]

bir sorum daha olacak

makronun şartlarına bir şart daha eklemek istiyorum."D sütunundaki değer olan ilk hücredeki rakamın ilk 3 rakamı eğer 152 ise " gibi bir şart .yalnız makro D sütunundaki kontrolü yaparken muhakkak aşağıdan yukarı doğru yapması gerekiyor.şimdiden teşekür ederim

 

[Orion1]

makronun şartlarına bir şart daha eklemek istiyorum."D sütunundaki değer olan ilk hücredeki rakamın ilk 3 rakamı eğer 152 ise " gibi bir şart .yalnız makro D sütunundaki kontrolü yaparken muhakkak aşağıdan yukarı doğru yapması gerekiyor.şimdiden teşekür ederim

Aşağıdaki kodları deneyiniz.

Sub maddeler()
Dim ilktarih As Date, sontarih As Date
Set sv = Sheets("veritabani")
Set sm = Sheets("madde")
ilktarih = CDate(sm.Cells(2, 8))
sontarih = CDate(sm.Cells(4, 8))
sm.Cells(21, 16) = 0
For r = 3 To sv.[a65536].End(3).Row
If CDate(sv.Cells(r, "b")) >= ilktarih And CDate(sv.Cells(r, "b")) <= sontarih And Val(Left(sv.Cells(r, "g"), 3)) = sm.Cells(21, 3) _
Or Val(Left(sv.Cells(r, "g"), 3)) = 152 Then
sm.Cells(21, 16).Value = sm.Cells(21, 16).Value + sv.Cells(r, "K").Value
End If
Next
Set sv = Nothing
Set sm = Nothing
End Sub

 

[metinavci23]

Sn.Orion 2
Ben galiba güzel anlatamamışım derdimi.sorunun şöyle.dosyada da gödüğünüz gibi bumlar mamul üretimleri.a sütününda üretim numaraları var.benim sorunum makronun her mamul üretiminin (yani d sütununu )kontrol edecek .arada eğer rakam 152 ile başlıyorsa toplam yapacak.yani bu şart ilk şarta bağlanacak.yalnız dediğim gibi her üretilem mamulü kontrol edecek.

 

[Orion1]

İlk şarta D sütunu kontrol şartıda eklendi.

Sub maddeler()
Dim ilktarih As Date, sontarih As Date
Set sv = Sheets("veritabani")
Set sm = Sheets("madde")
ilktarih = CDate(sm.Cells(2, 8))
sontarih = CDate(sm.Cells(4, 8))
sm.Cells(21, 16) = 0
For r = 3 To sv.[a65536].End(3).Row
If CDate(sv.Cells(r, "b")) >= ilktarih And CDate(sv.Cells(r, "b")) <= sontarih And Val(Left(sv.Cells(r, "g"), 3)) = sm.Cells(21, 3) _
And Val(Left(sv.Cells(r, "D"), 3)) = 152 Then
sm.Cells(21, 16).Value = sm.Cells(21, 16).Value + sv.Cells(r, "K").Value
End If
Next
Set sv = Nothing
Set sm = Nothing
End Sub

 

[metinavci23]

sorun

sorun devam ediyor.dosyayı tekrar gönderiyorum.sorunları renklendiedim.

 

[Orion1]

D sütununun dolu olması gerekiyor.
Ekli dosyayı inceleyiniz.

 

[metinavci23]

Sorun

Sn Orion 2 şöyle bir şey uygulamamız mümkün değilmi,yani offset olayı ile G sütünü dolu ise d süsununu kontrol edecek ,tabi ki dolu olan G sütunundaki hürelerin sol taraftaki d sutununda herhangi bir değer.yok.ancak D SUTUNUNDAKİ İLK DOLU DEĞERİ(TABİ AĞAIDAN YUKARI DOĞRU KONTROL EDEREK) ALSA BENİM İŞİMİ GÖRÜR DİYE DÜŞÜNÜYORUM. TABİ BU İŞLEMİ G SÜTUNUNDA İLK BOŞ HÜCREYİ GÖRDÜKTEN SONRA TEKRARLAMASI GEREKİYOR. SİZE FİKİR VERMEK HADDİM DEĞİL AMA BİR SORAYIM DEDİM

 

[Orion1]

Bence siz D sütununu doldurunuz.
Benim yapacağım dağa fazla bir şey yok.

 

[metinavci23]

yine de çok teşekür ederim sayın Orion 2.Yeni yılınızı şimdiden kutlar sağlık ve mutluluklar dilerim.
saygılarımla
Metin Avcıoglu

 

[Orion1]

yine de çok teşekür ederim sayın Orion 2.Yeni yılınızı şimdiden kutlar sağlık ve mutluluklar dilerim.
saygılarımla
Metin Avcıoglu

Rica ederim.
İyi yıllar.