Belirli Hücreye Değer Dağıtma Hk.

[Ömer2134]

Merhaba arkadaşlar

Yapmak istediğim şu şekildedir.

A3 hücresinde alabileceğim adet bulunmaktadır.
Ben alabileceğim adeti soldan sağa d,f,h,j,l,n,p ve r sütunlarına dağıtmak istiyorum.
Dağıtacağım adet a sütunundan büyük olmamalı.

Örneğin A4 sütununda 2 adet görünüyor. Bu ancak d4 ve h4 dağıtılması gerekiyor.

Şimdiden teşekkür ederim arkadaşlar.

 

[Korhan Ayhan]

Mesela 15 değerini nasıl dağıtmak istiyorsunuz?

 

[Ömer2134]

Korhan Hocam

15 benim alabileceğim stok adeti.. Benim 3. 5. ve 6. bölgede eksiğim var. Bu eksik bölgelere 1 er tane dağıtılacak. Yani ben 15 ten 3 tane almış oluyorum.

Bir alt satırda da( satır 4 ) 1. 3. ve 4. bölgede eksiğim var . Ama alabilecek adet 2 olduğu için soldan sağa doğru dağıtım yapması gerekiyor. 1. ve 3. bölgeye 1 er adet dağıtılacak.

Not : Tüm eksikler 1 ' er adet olarak dağıtılacaktır.

Teşekkürler.

 

[Ömer2134]

Dağıtılacak adet değişkende olabilir.

 

[Ömer2134]

Arkadaşlar yardımlarınızı rica ediyorum.

 

[Ömer BARAN]

Merhaba.

DAĞITILACAK-ALINACAK ve bölge kısımlarındaki MEVCUT ADET sütunlarının durumunun netleşmesinde yarar var sanırım.

-- MEVCUT adet ve ALINACAK adet toplamlarının bir önemi var mıdır?
-- Bir bölgeye sayı yazmak için o bölgenin MEVCUT adet sayısının 0 olması şart mıdır?
-- En önemlisi de;
...... hem ALINACAK ADET sütunundaki formül, bölgelerin ALINACAK ADET'lerinin toplamı,
...... hem de aynı sütunlara bu sayının dağıtılmasını istiyorsunuz,
bunda bir çelişki (döngüsel başvuru) yok mu?
-- Yoksa ALINACAK değil STOK sütunundaki sayılar, bölgelerin mevcut+dağıtılacak toplamının
dengelenmesi mi gerekiyor?

Örnek belgenizdeki tabloyu elle yazarak doldurursanız, izlenecek yöntemin netleşeceğini düşünüyorum.
.

 

[Ömer2134]

Sayın Ömer Hocam

-Mevcut adet benim şu an elimde bulunan stoktur. Eğer o bölgenin sıfırsa a sütunundan bi adet gidecektir.

- O bölgeye rakam yazmak için sıfır olması gerekir. 1 Adet varsa gerek yok. Sistem soldan sağa dağıtacaktır.

- Alınacak adet (B sÜTUNU), bölgelerin alacağı adetin toplamıdır.

Biraz zor bir konu yada ben yanlış anlatıyor olabilirim. Kusurabakmayın. Tekrardan dosyayı yüklüyorum.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub STOK_DAĞIT()
    Dim S1 As Worksheet, Son As Long, X As Long, Toplam As Double
    Dim WF As WorksheetFunction, Say As Long, Sütun As Integer, Veri As Range
    
    Set S1 = Sheets("Sayfa1")
    Set WF = WorksheetFunction
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Sütun = S1.Cells(2, S1.Columns.Count).End(1).Column
    
    For X = 3 To Son
        Say = WF.CountIfs(S1.Range("C2:WFD2"), "ALINACAK ADET", S1.Range("C" & X & ":WFD" & X), ">0")
        Toplam = S1.Cells(X, 2)
        For Each Veri In S1.Range("C2:" & Cells(2, Sütun).Address(0, 0))
            If Veri.Value = "MEVCUT ADET" Then
                If S1.Cells(X, Veri.Column) = 0 Then
                    Toplam = Toplam + 1
                    If Toplam > S1.Cells(X, 1) Then
                        Exit For
                    Else
                        S1.Cells(X, Veri.Column + 1) = S1.Cells(X, Veri.Column + 1) + 1
                    End If
                End If
            End If
        Next
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Ömer BARAN]

Merhaba.

Alternatif (umarım yanlış anlamadım).
Mavi satırlar varsa mevcut verileri silmek içindir,
ALINACAK ADET sütunları gerçek belgede boş ise mavi satırları silebilirsiniz.
.

Sub DAGIT()
son = Cells(Rows.Count, 1).End(xlUp).Row
[COLOR="Blue"]For sut = 4 To 18 Step 2
    Range(Cells(3, sut), Cells(son, sut)).ClearContents
Next[/COLOR]
For sat = 3 To [B][COLOR="Red"]son[/COLOR][/B]
kalan = Cells(sat, 1)
    For sut = 4 To 18 Step 2
        If kalan = 0 Then GoTo 10
        If Cells(sat, sut - 1) = 0 Then
            Cells(sat, sut) = 1
            kalan = kalan - 1
        End If
    Next
10: Next
MsgBox "İşlem tamamlandı." & vbLf & _
        "Sonuçları kontrol ediniz.", vbInformation, "..::.. Ömer BARAN ..::.."
End Sub

 

[Ömer2134]

Sayın Korhan Ayhan ve Ömer Baran teşekkür ederim . İki kodda çalışıyor.