• DİKKAT

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

icmali nasıl yapabilirim

peki bu excel icmal sayfasını yeniden nasıl pratik olrak icmale atabilirim. Bi anlatabilirmisiniz.
 
Şimdi bu yaptığım excel tablosu çalışan bir inşaat şirketinin deposu buraya mal geliyor ve gidiyor yani hergün 100 mal giriyo 100 mal çıkıyo benim bunu mal girişve çıkışı olarak da çalıştırmama gerekiyor. Ama mal girişi yapınca icmal çalışmıyor yani toplam yapmıyor.
Benim yolladığım dosyada Yoladığım şekilde bir hata varmı önce onu belirleyelim.
Hata varsa nokta vuruşu yapalım(Az önce söylediğim mesajdaki gibi).Hatanın nerde olduğunu bulalım.
Eğer onda yolladığım şekilde hata yoksa başka bir sebep vardır ona bakalım.:cool:
 
Yok burda bi hata yok yalnızca hani söylediğim gibi malzeme ekleyince nasıl çalışacak
 
yok herhangi bihata yalnızca malzeme gelince bu icmale nasıl ekelnecek
 
Şimdi bu yaptığım excel tablosu çalışan bir inşaat şirketinin deposu buraya mal geliyor ve gidiyor yani hergün 100 mal giriyo 100 mal çıkıyo benim bunu mal girişve çıkışı olarak da çalıştırmama gerekiyor. Ama mal girişi yapınca icmal çalışmıyor yani toplam yapmıyor.
Ama siz yolladığınız dosyada durumu böyle tasarlammışsınız.
Mal girişi için 18 satır,mal çıkışı için de 8 satır düzenlemişsiniz.
Tabiki bende kodları elimdeki dosyaya bakıp yapacağımdan.Mal girişini 18 satır tuttum mal çıkışınıda 8 satır tuttum.Fakat bu mesajımdan gördüğüm kadarı ile durum sizin yolladığınız dosyanın gibi değil .Farklı.
Eğer durum böyleyse yolladığınız dosyadaki gibi mal giriş ve çıkışı tasarımı pek kullanışlı değil.
Bunun için malgirişi olduğu yerde kalsın.Mal çıkışı için ise M sütunundan başlayarak verilerinizi girin.
O zaman ben kodu esnek yapıcam ister 100 satır isterse 1000 satır olsun farketmez.Duruma göre kod yazacam.:cool:
 
Böyle bişey olsa icmali olurmu acaba düzeltip gönderirseniz memnun olurum.
 
Böyle bişey olsa icmali olurmu acaba düzeltip gönderirseniz memnun olurum.
Siz dosyanızdaki ilgili sayfaları bu dediğim şekilde düzenleyip yollayın.Ben kodları bu duruma göre tekrar güncelleyecem.Problem çözülecek:cool:
 
dosyayaı ekleyemedim yalnız hazır ama
Eğer dosyanın boyutu çok büyükse form buna izin vermiyor.Winrar ile sıkıştırıp yollayın.
Yine olmuyorsa bir upload sitesine yükleyip link verin.:cool:
 
yok dosyayı nerden yollayacağımı kaybettim yoksa 250 kb civarında bşiey
 
yok dosyayı nerden yollayacağımı kaybettim yoksa 250 kb civarında bşiey
Mesaj yazdığınız yerin biraz dağa alt tarfında Browserin kaydırma çubuğunu az bişey aşağı çekin.
Orada bir buton göreceksiniz.Dosya ekle veya sil.Ona basın ve yükleyin.
 
Merhaba Birazını düzelltim ama bi denerseniz sevinirim.
 
buda düzelttiğim dosya
Dosyanız ektedir.:cool:
Kod:
Sub icmal_59()
Dim z As Object, myarr(), a(), n As Long, sh As Worksheet
Dim j As Long, i As Long, x As Long, sat As Long, t As Byte
Set z = CreateObject("Scripting.Dictionary")
Sheets("İ C M A L").Select
Range("B7:G65536").ClearContents
Application.ScreenUpdating = False
ReDim myarr(1 To 5, 1 To 65536)
For t = 3 To 14 Step 11
    For j = 1 To Worksheets.Count
        If IsNumeric(Sheets(j).Name) Then
            Set sh = Sheets(j)
            If t = 3 Then
                sat = sh.Cells(65536, "C").End(xlUp).Row
                a = sh.Range("C9:H" & sat).Value
            End If
            If t = 14 Then
                sat = sh.Cells(65536, "N").End(xlUp).Row
                a = sh.Range("N9:R" & sat).Value
            End If
            For i = 1 To UBound(a)
                If a(i, 1) <> "" Then
                    If t = 3 Then
                        If Not z.exists(a(i, 1)) Then
                            n = n + 1
                            z.Add a(i, 1), n
                            myarr(2, n) = a(i, 1)
                            myarr(1, n) = a(i, 2)
                        End If
                        myarr(3, z.Item(a(i, 1))) = myarr(3, z.Item(a(i, 1))) + a(i, 6)
                        myarr(5, z.Item(a(i, 1))) = myarr(3, z.Item(a(i, 1))) - myarr(4, z.Item(a(i, 1)))
                ElseIf t = 14 Then
                    If Not z.exists(a(i, 1)) Then
                        n = n + 1
                        z.Add a(i, 1), n
                        myarr(2, n) = a(i, 1)
                    End If
                    myarr(4, z.Item(a(i, 1))) = myarr(4, z.Item(a(i, 1))) + a(i, 5)
                    myarr(5, z.Item(a(i, 1))) = myarr(3, z.Item(a(i, 1))) - myarr(4, z.Item(a(i, 1)))
                End If
            End If
        Next i
        Erase a
    End If
    Next j
Next t
Application.ScreenUpdating = True
Range("C7").Resize(z.Count, 5) = Application.Transpose(myarr)
Range("C7:G65536").Sort Range("C7")
For i = 7 To Cells(65536, "C").End(xlUp).Row
    Cells(i, "B").Value = i - 6
Next
MsgBox "İcmal Çıkarıldı" & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"

End Sub
 

Ekli dosyalar

dostum lütfen bana ne ile yaptığını anlatabilirmisin çünkü hala bu örneğin 19. sayfadaki malzemeyi eksiltmemiş
 
Geri
Üst