girilen veri sayfasından lisxbox a malzeme içmali almak

[a_self_lion]

bir içmal dökümü alabilmem için yine dizi yöntemini kullanarak veya başka farklı bir yöntemlede olabilir
B sutunundaki iki tarih arasında 01.01.2012 ile 31.01.2012 tarihleri arasında ve D sutunundaki ALIS olanların
E sutunundaki MLZ_KOD larımın aynı malzeme kodu ise bunun VR_MIKTAR H sutununu toplasın aynı zaman ve J Sutunundaki değerleri toplasın ve listbox6 da bana göstersin yapmak istediğimi sanırım sayın KORHAN bey çok iyi anladı.
D sutununda bir çok malzeme kodu aşağı doğru giriliyor.

02.01.2012 82103003 CEVİZLİ BAKLAVA ALIS 3 KG 45
05.01.2012 82103003 CEVİZLİ BAKLAVA ALIS 2 KG 30
15.01.2012 82103003 CEVİZLİ BAKLAVA ALIS 4 KG 60
27.01.2012 82103003 CEVİZLİ BAKLAVA ALIS 1 KG 15


ve bunları Değerleri..

01.01.2012 ile 31.01.2012 tarihleri arasında D sutunu ALIS olan
malzemelerin içmalini almak istiyorum.

82102003 CEVİZLİ BAKLAVA 10 KG. 150.00 TL gibi bir rapor yapmak istiyorum...

 

[a_self_lion]

Worksheets("veri").Visible = True

Dim a, i, satir, k, b(), z
Set s1 = Sheets("veri")
Set s2 = Sheets("Fatura")
'*******************************************
a = s1.Range("a2:v" & s1.[a65536].End(3).Row).Value 'veri sayfasındaki veriler a değişkenine tanımlanıyor.
ReDim b(1 To UBound(a, 1), 1 To 6) ' Dizinin boyutu belirleniyor.
With CreateObject("Scripting.Dictionary") 'Dictionary nesnesi yaratılıyor.
.CompareMode = vbTextCompare
For i = 1 To UBound(a, 1)
If CDate(a(i, 2)) >= CDate(TextBox1) And CDate(a(i, 2)) <= CDate(TextBox2) Then 'Eğer a değişkeninin 2. verisi girilen tarihler arasında ise
'If Not IsEmpty(a(i, 7)) Then ' a değişkeninin 7.elemanı boş değil ise yani sayı sutununda dğer var ise
' z = a(i, 5) & ":" & a(i, 7) ' a değişkeninin 5. ve 7. verilerini z'de birleştir.
'If Not .exists(z) Then ' z değişkeni yok ise
satir = satir + 1
b(1, satir) = satir ' Dizinin 1.elemanı Sıra No
b(2, satir) = a(i, 5) 'Dizinin 2.elemanı mlz kodu
b(3, satir) = a(i, 6) 'Dizinin 3.elemanı mlz adı
b(4, satir) = a(i, 7) 'Dizinin 4.elemanı mlz brim
' .Add z, satir
'End If
b(5, satir) = b(5, satir) + a(i, 8) ' Dizinin 4.elemanına (a değişkeninin 8 verisi toplanıyor) yani gelen toplanıyor aynı ise
b(6, satir) = b(6, satir) + a(i, 10) ' Dizinin 5.elemanına (a değişkeninin 9 verisi toplanıyor) yani iade toplanıyor aynı ise

'End If
End If
Next
End With
's2.Range("a2:e500").ClearContents
's2.[a2].Resize(n, 6).Value = b ' yukarda tanımlanıp içine veri alınan b Dizisi Sayfa2'ye kopyalanıyor.
If satir > 0 Then ListBox1.Column = b

'*******************************************
'sıralama b1 e göre
's2.[b2].Resize(n, 5).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
' OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
' DataOption1:=xlSortNormal
Range("B2").Select ' Sıralanıyor.
'*******************************************
MsgBox "Bitti"
'[a1].Select
Set s1 = Nothing
Set s2 = Nothing

Yukarıdaki kodlarla denedim ama bir türlü karşılaştırma yaparak birinci mesajımda yapmak istediğmi yapamadım. Yardımcı olursanız sevinirim.

 

[a_self_lion]

Aşağıdaki kodlarla yukarıdaki görüntüyü elde edebildim. Fakat iki tane tekrarlanan ürünlerde son tutar bölümünde hem topluyor fakat sağına doğru onlarıda getiriyor sebebi ne olabilir.

Worksheets("veri").Visible = True

Dim a, i, satir, k, b(), z
Set s1 = Sheets("veri")
Set s2 = Sheets("Fatura")
'*******************************************
a = s1.Range("a2:v" & s1.[a65536].End(3).Row).Value 'veri sayfasındaki veriler a değişkenine tanımlanıyor.
ReDim b(1 To UBound(a, 1), 1 To 150) ' Dizinin boyutu belirleniyor.
With CreateObject("Scripting.Dictionary") 'Dictionary nesnesi yaratılıyor.
.CompareMode = vbTextCompare
For i = 1 To UBound(a, 1)
If CDate(a(i, 2)) >= CDate(TextBox1) And CDate(a(i, 2)) <= CDate(TextBox2) Then 'Eğer a değişkeninin 2. verisi girilen tarihler arasında ise
If Not IsEmpty(a(i, 5)) Then ' a değişkeninin 7.elemanı boş değil ise yani sayı sutununda dğer var ise
z = a(i, 5) ' birleşirmedim & ":" & a(i, 7) ' a değişkeninin 5. ve 7. verilerini z'de birleştir.
If Not .exists(z) Then ' z değişkeni yok ise

satir = satir + 1

b(satir, 1) = satir ' Dizinin 1.elemanı Sıra No
b(satir, 2) = a(i, 5) 'Dizinin 2.elemanı mlz kodu
b(satir, 3) = a(i, 6) 'Dizinin 3.elemanı mlz adı
b(satir, 4) = a(i, 7) 'Dizinin 4.elemanı mlz brim
.Add z, satir
End If
b(.Item(z), 5) = b(.Item(z), 5) + a(i, 8) ' Dizinin 4.elemanına (a değişkeninin 8 verisi toplanıyor) yani gelen toplanıyor aynı ise
b(.Item(z), 6) = b(.Item(z), 6) + a(i, 10) ' Dizinin 5.elemanına (a değişkeninin 9 verisi toplanıyor) yani iade toplanıyor aynı ise

' b(.Item(z), 5) = b(.Item(z), 5) + a(i, 8) ' Dizinin 4.elemanına (a değişkeninin 8 verisi toplanıyor) yani gelen toplanıyor aynı ise
' b(.Item(z), 6) = b(.Item(z), 6) + a(i, 9) ' Dizinin 5.elemanına (a değiş




End If
End If
Next
End With
's2.Range("a2:e500").ClearContents
's2.[a2].Resize(n, 6).Value = b ' yukarda tanımlanıp içine veri alınan b Dizisi Sayfa2'ye kopyalanıyor.
If satir > 0 Then ListBox1.Column = Application.Transpose(b)

'*******************************************
'sıralama b1 e göre
's2.[b2].Resize(n, 5).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
' OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
' DataOption1:=xlSortNormal
Range("B2").Select ' Sıralanıyor.
'*******************************************
MsgBox "Bitti"
'[a1].Select
Set s1 = Nothing
Set s2 = Nothing
'Worksheets("veri").Visible = False
'Unload Me

 

[Zeki Gürsoy]

Dosyayı ekleyebilir misiniz?

 

[a_self_lion]

teşekkürler Zeki bey o alanların metin olmasından kaynaklanıyormuş sayıya dönüştürünce sorunu hallettim.