Makro İle Stok Girişi

[MythSoldier]

Merhaba herkese iyi çalışmalar.Ekteki dosyamda stok giriş çıkışı yapıyorum.Normalde çoketopla formülü ile stok miktarlarını hesaplatıyordum fakat çok fazla veri olmasından dolayı excel çok kasıyor.Sizden ricam buton veya user form aracılığı ile stok giriş çıkışı yapabilmemi sağlayacak bir makro.Yardım ederseniz sevinirim.

 

[fireman64]

Bu program fazlasıyla işinizi görecektir.

 

[vardar07]

Eklediğiniz dosya eksik gibi görünüyor. Çoketopla formülünü hangi sayfada kullanıyorsunuz,Stok sayfasında ne kadar miktar var,stok hareketlerinde hep çıkış var giriş olunca ne olacak tefarrauatlı olacak şekilde sorunuzu düzeltirseniz daha çabuk yardım alma şansınız artar.Bilginize.

 

[MythSoldier]

İlginize teşekkür ederim.vardar07 çoketoplalı şekilde dosyayı yüklüyorum,formülü stok sayfasının miktar stununda kullanıyorum değerlerin negatif olduğuna bakma girişlerin bi kısmını girmedim henüz.Evet çoğu çıkış şeklinde çünkü girişler tek tük toptan bir şekilde giriliyor.Program bu şekle döndüğü zaman yeni bir veri eklediğimde çoketopla birsürü satır kontrol ettiği için ciddi bi yavaşlama oluyor malum 680 satırda formül var.Bunu bu kadar formül kalabalığındansa daha rahat bi şekilde stok ekleyip çıkarabileceğim bi makro arıyorum.Stok giriş-çıkış sayfasına stok kodunu ve miktarını yazdığım zaman, stok sayfasında o stok kodunu bulup miktarını arttırmasını yada azaltmasını istiyorum.

fireman64 attığınız linki inceledim program fazla detaylı benim tek yapıcağım stok ekleyip çıkartmak ilginize teşekkür ederim

 

[Ziynettin]

Merhaba,

Stok sayfası kalan miktar için yapılan çalışma.

Option Explicit
Sub Stok_Topla()
Dim a(), b(), c(), d As Object, d1 As Object
Dim i As Long, Son1 As Long, Son2 As Long, t As Double
Dim S1 As Worksheet, S2 As Worksheet
t = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set S1 = Sheets("Stok")
Set S2 = Sheets("Stok Hareketleri")
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")

Son1 = S1.Range("B" & Rows.Count).End(3).Row
Son2 = S2.Range("C" & Rows.Count).End(3).Row

b = S1.Range("B2:B" & Son1)
a = S2.Range("C2:E" & Son2)

For i = 1 To UBound(a)
If a(i, 2) = "Çıkış" Then
    d(a(i, 1)) = d(a(i, 1)) + CDbl(a(i, 3))
    Else
    d1(a(i, 1)) = d1(a(i, 1)) + CDbl(a(i, 3))
    End If
Next i
   
ReDim c(1 To UBound(b), 1 To 1)
For i = 1 To UBound(b)
c(i, 1) = d1(b(i, 1)) - d(b(i, 1))
Next i
S1.Range("C2:C" & Rows.Count).ClearContents
S1.Range("C2").Resize(UBound(b)) = c
S1.Range("C2").Resize(UBound(b)).NumberFormat = "#,##0.00"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "İşleminiz Bitti." & vbLf & vbLf & "Süre : " & _
        Format(Timer - t, "0.00") & " saniye", vbInformation
End Sub

 

[MythSoldier]

Aradığım buydu vakit ayırdığınız için teşekkür ederim.

 

[vardar07]

Userform ile alternatif.

 

[MythSoldier]

vardar07 elinize sağlık çok güzel bir çalışma olmuş teşekkür ederim.

 

[tok42]

slm arkadaşlar bu döngüyü nasıl yapabiliriz
Sub deee()
'Sheets("Sayfa1").Range("A65536").End(xlUp).Offset (1, 0).Select
Range("A2").Select
Selection.Copy
If Range("A3") = "" Then
Range("A3").Select
Else
Range("A4").Select
End If
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

 

[YUSUF44]

slm arkadaşlar bu döngüyü nasıl yapabiliriz
Sub deee()
'Sheets("Sayfa1").Range("A65536").End(xlUp).Offset (1, 0).Select
Range("A2").Select
Selection.Copy
If Range("A3") = "" Then
Range("A3").Select
Else
Range("A4").Select
End If
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

Asıl yapmak istediğiniz nedir?