• DİKKAT

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

Günlük Rapor Programında BÜYÜK SORUN!

Katılım
4 Mart 2012
Mesajlar
69
Excel Vers. ve Dili
2007
Merhaba arkadaşlar yeni bir sıkıntıyla karşınızdayım.Sayenizde çok şey öğreniyorum ve neredeyse bildiğim pek çok bilgiyi size borçluyum...Neyse uzatmadan sorunumuza geçelim.

Bir excel dosyam var
BURAYA TIKLAYARAK İNDİREBİLİRSİNİZ

Bu dosyada sırasıyla "Barkod Takip","Bul" ve "Günlük" sayfaları var.
"Barkod Takip" sayfasına veri girişi yapıyorum.O güne ait günlük verileri giriyorum (burada sorun yok)
"Bul" sayfası bu veriler içerisinde pratik bir arama yapabilmek için oluşturulmuş bir gelişmiş filtre barındırıyor (burada da sorun yok)
"Günlük" sayfamda ise seçilen günde girilen verileri çekebilen bir makro oluşturdum ancak burdaki sorunum şu ben burada aynı cins ürünlerin tek kalemde toplanmasını ve kasa adetlerini getirmek istiyorum.Çalıştırdığım makro kimi zaman fazla kasa getirirken kimi zaman da eksik getirebiliyor yada aynı ürünü iki kez satıra yazıp sayılarını dağıtıyor.

Şuanda anlamanızı beklemiyorum ancak örnek dosyayı açarsanız daha kolay anlaşılacak diye umut ediyorum.Bu benim çok önemli ve acil umarım yardımcı olursunuz.

Örneği açtığınızda doğrudan günlük sayfasına gelin.Önce günlüğü temizle tuşuna basın sonra da günlük getir tuşuna...Diğer tuşlara basmanıza gerek yok çünkü hepsini zaten günlük getir butonuna bağlamıştım.
 

Ekli dosyalar

Alternatif olarak bu kodu bir mödüle kopyalayın ve GÜNLÜK sayfasında bu kodu çalıştırın.

not:
GÜNLÜK sayfasındaki B2 hücresindeki tarihe göre verileri alır.

kod:

Kod:
Sub Gruplandir()

ZBasla = TimeValue(Now)
zaman = Timer

Set s1 = Sheets("BARKOD TAKİP") ' veri sayfası
Set s2 = Sheets("GÜNLÜK") 'aktarılan sayfa
Dim i
s2.Range("a8:k" & Rows.Count).ClearContents
son1 = s1.Cells(Rows.Count, "e").End(3).Row
tarih = CDate(s2.Cells(2, "b").Value)

ReDim ara1(son1): ReDim ara2(son1): ReDim ara3(son1):

For J = 2 To son1

deg1 = WorksheetFunction.Trim(s1.Cells(J, "f"))
deg2 = WorksheetFunction.Trim(s1.Cells(J, "g"))
deg3 = WorksheetFunction.Trim(s1.Cells(J, "h"))
deg4 = WorksheetFunction.Trim(s1.Cells(J, "j"))
deg5 = WorksheetFunction.Trim(s1.Cells(J, "k"))
deg6 = WorksheetFunction.Trim(s1.Cells(J, "l"))
deg7 = WorksheetFunction.Trim(s1.Cells(J, "ı"))

ara1(J) = deg1 & deg2 & deg3 & deg4 & deg5 & deg6 & deg7
ara2(J) = 1
ara3(J) = CDate(WorksheetFunction.Trim(s1.Cells(J, "e")))

Next J

sat1 = 8

For r = 2 To son1
aranan1 = ara1(r)
sut2 = 0
If ara3(r) = CDate(tarih) Then
If ara2(r) = 1 Then
For i = r To son1
If ara1(i) = aranan1 Then
sut2 = sut2 + 1
ara2(i) = 0
End If
Next i

s2.Cells(sat1, 1).Value = s1.Cells(r, "e").Value
s2.Cells(sat1, 2).Value = s1.Cells(r, "f").Value
s2.Cells(sat1, 3).Value = s1.Cells(r, "g").Value
s2.Cells(sat1, 4).Value = s1.Cells(r, "h").Value
s2.Cells(sat1, 5).Value = s1.Cells(r, "j").Value
s2.Cells(sat1, 6).Value = s1.Cells(r, "k").Value
s2.Cells(sat1, 7).Value = s1.Cells(r, "l").Value
s2.Cells(sat1, 8).Value = s1.Cells(r, "ı").Value
s2.Cells(sat1, 9).Value = s1.Cells(r, "m").Value
s2.Cells(sat1, 10).Value = sut2
s2.Cells(sat1, 11).Value = s1.Cells(r, "n").Value

sat1 = sat1 + 1

End If
End If
Next r

zBitis = TimeValue(Now)

MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla), vbInformation, " Sonuç Penceresi"

End Sub
 
Kıstasları tam olarak anlatamamışım sanırım...Burda ürünlerdeki değişkenler şu şekilde...

Ürün-Yüzey Şekli-Kalite-Kalınlık-En-Boy

Örn: Botticino-Polished-A-1.2-45.7-45.7 gibi... bu bir ürün.

Yanı sıra bu kriterlerden herhangi biri bile değişse ürün kalemi değişmiş oluyor.Ve farklı olarak sayması gerekiyor.Ben yazdığı programda tuhaf bi şekilde hatalı çekiyor. Birde rica etsem benim dosyam üzerinden çalışır mısınız.Eklediğiniz eki inceledim.Hazırladığınız dosya yalnızca Ürün ismi bazında sayım yapıyor
 
Geri
Üst