DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Benim yolladığım dosyada Yoladığım şekilde bir hata varmı önce onu belirleyelim.Ş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.Ş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.
Siz dosyanızdaki ilgili sayfaları bu dediğim şekilde düzenleyip yollayın.Ben kodları bu duruma göre tekrar güncelleyecem.Problem çözülecekBöyle bişey olsa icmali olurmu acaba düzeltip gönderirseniz memnun olurum.
Eğer dosyanın boyutu çok büyükse form buna izin vermiyor.Winrar ile sıkıştırıp yollayın.dosyayaı ekleyemedim yalnız hazır ama
Mesaj yazdığınız yerin biraz dağa alt tarfında Browserin kaydırma çubuğunu az bişey aşağı çekin.yok dosyayı nerden yollayacağımı kaybettim yoksa 250 kb civarında bşiey
Merhaba Birazını düzelltim ama bi denerseniz sevinirim.
Dosyanız ektedir.buda düzelttiğim dosya
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