Excel de Transfer Oluşturma

[Gzagli]

Merhaba arkadaşlar,
Öncelikle konuyu doğru yere mi açtım bilmiyorum fakat yanlış yerdeyse eğer Moderatör arkadaşlardan ricam doğru yere taşımalarıdır.

Soruma gelecek olursak;
Mağazalar arası ürün transferi gerçekleştirmek istiyorum. Hazırlamış olduğum dosyada Giren, Satan ve Stok durumuna göre "Kalan Stok" oluşturdum. Kalan stok %75 in üzerinde ise gönderilecek şeklinde bir ek sütun oluşturdum. Lakin hangi mağazaya gönderileceğini veya alınacağını ayarlayamadım.

Benim istediğim;
"ABC" ürün kodu mevcut mağazaların hepsinde olduğunu farzedelim.


Mağaza1 - ABC -
Mağaza2 - ABC -
Mağaza3 - ABC -

Aynı ürün koduna sahip mağazalardan birbirine transferini gerçekleştirmek istiyorum. Kalan stok durumuna göre stokda çok olandan en az olana transferi nasıl gerçekleştirebilirim.



Yardımlarınız için şimdiden teşekkürler.

 

[Ömer BARAN]

Merhaba, foruma hoşgeldiniz.

Sorunuzu, ekran görüntüsü yerine, örnek belge ile desteklerseniz,
daha hızlı sonuca ulaşabilir, alternatif cevaplar alabilirsiniz diye düşünüyorum.

Örnek belge özellikleri ve örnek belge yükleme yöntemine ilişkin açıklamalar
cevabımın altındaki İMZA bölümünde var.
.

 

[Gzagli]

Merhaba, foruma hoşgeldiniz.

Sorunuzu, ekran görüntüsü yerine, örnek belge ile desteklerseniz,
daha hızlı sonuca ulaşabilir, alternatif cevaplar alabilirsiniz diye düşünüyorum.

Örnek belge özellikleri ve örnek belge yükleme yöntemine ilişkin açıklamalar
cevabımın altındaki İMZA bölümünde var.
.

Merhaba
Örnek belge linkteki gibidir. İnceleyip geri dönüş yapabilecek arkadaşlar için şimdiden teşekkürler.

 

[Korhan Ayhan]

Dosyanız aslında 79 KB boyutunda...

Fakat siz linke 21 MB olan bir dosya yüklemişsiniz. (Gereksiz satırlardan dolayı)

Kotalı üyelerimizi düşünerek dosyalarınızı eklerseniz sevinirim.

Sorunuza gelince dağıtım işlemini makro ile yapmak daha uygun görünüyor.

Cevap gelmezse akşam müsait olduğumda bakabilirim.

 

[Gzagli]

Dosyanız aslında 79 KB boyutunda...

Fakat siz linke 21 MB olan bir dosya yüklemişsiniz. (Gereksiz satırlardan dolayı)

Kotalı üyelerimizi düşünerek dosyalarınızı eklerseniz sevinirim.

Sorunuza gelince dağıtım işlemini makro ile yapmak daha uygun görünüyor.

Cevap gelmezse akşam müsait olduğumda bakabilirim.

Gereksiz satırları silerek dosya linkini güncelledim.
Transfer 1.xlsx - 75 KB

 

[Gzagli]

Konu günceldir.

 

[Korhan Ayhan]

Merhaba,

Basit bir mantık kurdum. Geliştirmek gerekebilir.

"P" sütunu yardımcı sütun olarak kullanılmıştır. Boş olması gerekiyor.

Sub TRANSFERLERİ_AKTAR()
    Son = Cells(Rows.Count, 1).End(3).Row
    Range("P3") = 1
    Range("P4") = 2
    Range("P3:P4").AutoFill Destination:=Range("P3:P" & Son), Type:=xlFillDefault
    Range("A3:P" & Son).Sort Key1:=Range("C3"), Order1:=xlAscending, Key1:=Range("G3"), Order2:=xlAscending
    
    For X = 3 To Son
        If Cells(X, "L") = "Gönderilecek" Then
            Say = WorksheetFunction.CountIf(Range("C:C"), Cells(X, "C"))
            
            For Y = X + 1 To X + Say
                If Cells(X, "C") = Cells(Y, "C") Then
                    If Cells(Y, "K") <= 0.75 Then
                        Cells(Y, "G") = Cells(Y, "G") + 1
                        Cells(X, "G") = Cells(X, "G") - 1
                    End If
                End If
            Next
        End If
    Next
    
    Range("A3:P" & Son).Sort Key1:=Range("P3"), Order1:=xlAscending, Key1:=Range("G3"), Order2:=xlAscending
    Range("P3:P" & Son).ClearContents
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Gzagli]

Merhaba,

Basit bir mantık kurdum. Geliştirmek gerekebilir.

"P" sütunu yardımcı sütun olarak kullanılmıştır. Boş olması gerekiyor.

Sub TRANSFERLERİ_AKTAR()
    Son = Cells(Rows.Count, 1).End(3).Row
    Range("P3") = 1
    Range("P4") = 2
    Range("P3:P4").AutoFill Destination:=Range("P3:P" & Son), Type:=xlFillDefault
    Range("A3:P" & Son).Sort Key1:=Range("C3"), Order1:=xlAscending, Key1:=Range("G3"), Order2:=xlAscending
    
    For X = 3 To Son
        If Cells(X, "L") = "Gönderilecek" Then
            Say = WorksheetFunction.CountIf(Range("C:C"), Cells(X, "C"))
            
            For Y = X + 1 To X + Say
                If Cells(X, "C") = Cells(Y, "C") Then
                    If Cells(Y, "K") <= 0.75 Then
                        Cells(Y, "G") = Cells(Y, "G") + 1
                        Cells(X, "G") = Cells(X, "G") - 1
                    End If
                End If
            Next
        End If
    Next
    
    Range("A3:P" & Son).Sort Key1:=Range("P3"), Order1:=xlAscending, Key1:=Range("G3"), Order2:=xlAscending
    Range("P3:P" & Son).ClearContents
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Öncelikle teşekkürler üstad.
Bunu nereye yazacağım onu da belirtirseniz çok makbule geçecek

 

[Korhan Ayhan]

Dosyanızı açın.
ALT+F11 tuşlarına basıp kod editörünü açın.
INSERT menüsünden MODULE seçeneğini seçin.
Sağ tarafta açılan beyaz bölüme kodu uygulayın.
Excel sayfasına dönün ekle menüsünden sayfaya bir şekil ekleyin. Buton olarak kullanılacak.
Sonra şekil üzerinde sağ tıklayıp makro ata komutunu tıklayın.
Ekrana gelen pencerede görünen makro adını seçip tamam deyin.

Son olarak dosyanızı farklı kaydet diyerek "Makro İçerebilen Excel Çalışma Kitabı" formatında kayıt edin.

Tekrar dosyanızı açıp butona tıklayın.

 

[Gzagli]

Denedim fakat mağaza transferleri gerçekleşmiyor.

 

[Gzagli]

Konu hakkında yardımcı olabilecek olursa çok sevinirim. Formul arayışım devam etmektedir.