Hücredeki adet kadar farklı hücreye hücre değerini yazdırma

[MiRaBiLiS]

Merhaba arkadaşlar,

bir formda şöyle bir formüle ihtiyacım var.
1. alan

2. alan

1. alanda yazdığım g8 hücresindeki palet sayısı kadar b8 hücresindeki veriyi 2. alanın d13 hücresinden başlayıp aşağıya kadar yazsın.

eğer oluyor ise de eğer g9-g10 şeklinde altlarda da veri varsa aynı şekilde 2. alanda onları da alt alta g8deki sayıda yazdıktan sonra yazmaya devam etsin.

böyle birşey formül ile mümkün müdür acaba arkadaşlar?

yardımınızı rica ediyorum..

 

[antonio]

Merhaba,
İstediğniz zor bir şey değildir. Ancak bilinmesi gereken şudur:
Birinci ve ikinci alanların aynı sayfada olmadıkları anlaşılıyor. Birinci alan Sayfa1 de, ikinci alan Sayfa2 de olarak varsayalım mı? Değilse sayfa adlarını belirtirseniz sizin için kolaylık olur.

 

[MiRaBiLiS]

1. sayfa ='DEPO GİRİŞ-ÇIKIŞ'!
2. sayfa ='YÜKLEME FORMU'!

teşekkürler.

 

[antonio]

Alt + F11 tuşları ile açılan kod penceresine aşağıdaki kodları yapıştırınız. İsterseniz sayfaya bir buton çizerek sağ tıklayıp "Makro Ata" seçeneği ile kodu düğmeye bağlayabilirsiniz. Sadece ürün kodunu değil, ürün adını da yazacak şekilde hazırladım. Kodlarınız aşağıdadır:

Sub bulunan_adet_kadar_yaz()
Dim s1 As Worksheet, s2 As Worksheet, ss As Long, palet_adedi As Integer, _
    hcr As Range, sat As Long

Set s1 = Sheets("DEPO GİRİŞ-ÇIKIŞ")
Set s2 = Sheets("YÜKLEME FORMU")
ss = s1.Range("G" & Rows.Count).End(3).Row

For i = 8 To ss
    Set hcr = s1.Range("G" & i)
    If IsNumeric(hcr.Value) = True And hcr.Value <> "" Then
        palet_adedi = hcr.Value
       [COLOR="Red"][B] sat = s2.Range("D48").End(3).Row[/B][/COLOR]
        
        For a = sat + 1 To sat + palet_adedi
            s2.Range("D" & a).Value = s1.Range("B" & i).Value
            s2.Range("B" & a).Value = s1.Range("C" & i).Value ' Ürün adı da yazdırmak isterseniz. (istemezseniz bu satırı silin)
        Next a
    End If
Next i
Set s1 = Nothing
Set s2 = Nothing
Set hcr = Nothing
MsgBox "İşlem tamamlandı", vbInformation, "antonio"
End Sub

 

[MiRaBiLiS]

Alt + F11 tuşları ile açılan kod penceresine aşağıdaki kodları yapıştırınız. İsterseniz sayfaya bir buton çizerek sağ tıklayıp "Makro Ata" seçeneği ile kodu düğmeye bağlayabilirsiniz. Sadece ürün kodunu değil, ürün adını da yazacak şekilde hazırladım. Kodlarınız aşağıdadır:

Sub bulunan_adet_kadar_yaz()
Dim s1 As Worksheet, s2 As Worksheet, ss As Long, palet_adedi As Integer, _
    hcr As Range, sat As Long

Set s1 = Sheets("DEPO GİRİŞ-ÇIKIŞ")
Set s2 = Sheets("YÜKLEME FORMU")
ss = s1.Range("G" & Rows.Count).End(3).Row

For i = 8 To ss
    Set hcr = s1.Range("G" & i)
    If IsNumeric(hcr.Value) = True And hcr.Value <> "" Then
        palet_adedi = hcr.Value
        sat = s2.Range("D" & Rows.Count).End(3).Row
        
        For a = sat + 1 To sat + palet_adedi
            s2.Range("D" & a).Value = s1.Range("B" & i).Value
            s2.Range("B" & a).Value = s1.Range("C" & i).Value ' Ürün adı da yazdırmak isterseniz. (istemezseniz bu satırı silin)
        Next a
    End If
Next i
Set s1 = Nothing
Set s2 = Nothing
Set hcr = Nothing
MsgBox "İşlem tamamlandı", vbInformation, "antonio"
End Sub

merhaba,
bunu yaptığımda çalıştı ancak şöyle bir sorun oldu, D13 hücresi yerine D49 hücresinden yazmaya başladı bunun başlangıç hücresini belirtebiliyor muyuz acaba?


sanırım burada belirtmediğim şey, bu d13 hücresinden sonra 33 satır boş alan olduğu ve alt kısmında bilgilerin isimlerin girildiği tabloların yer aldığıydı. o ilk boş bulduğu sıradaki hücreden başlayarak yazmaya başladığı için altlarda formun bittiği yerden yazmaya başlıyor.

koda sadece ilk başlangıç noktan şu diye belirtmemiz gerekli sadece. ben denedim değiştirerek bazı şeyleri ancak tek satırlı bir veri olduğunda sorun olmadı ama iki farklı ürün olduğu zaman birinciyi bitirince ikinciyi tekrar baştan başlayarak yazıyor altına devam etmiyor.

 

[antonio]

merhaba,
bunu yaptığımda çalıştı ancak şöyle bir sorun oldu, D13 hücresi yerine D49 hücresinden yazmaya başladı bunun başlangıç hücresini belirtebiliyor muyuz acaba?

Program en son dolu satırı arayıp buluyor. O yüzden olmuştur. Dosyanızdaki veriler 48 nci satıra kadar önceden yazılmış olabilir. Kontrol edin, hata varsa gidermeye çalışacağım.

 

[EmrExcel16]

ss = s1.Range("G" & Rows.Count).End(3).Row

Yerine aşagidaki kodu yazarsaniz belki düzelir

ss = s1.Range("G48").End(xlup).Row

Eğer tablonuz standart ise isinizi gorecektir G48 verilerinizin gelecegi son satirdir .
Eger verileriniz 33 satirdan fazla olursa isinizi görmez.

 

[antonio]

4 numaralı mesajda güncellemeyi yaptım (kırmızı renkli)

 

[MiRaBiLiS]

4 numaralı mesajda güncellemeyi yaptım (kırmızı renkli)

ss = s1.Range("G" & Rows.Count).End(3).Row

Yerine aşagidaki kodu yazarsaniz belki düzelir

ss = s1.Range("G48").End(xlup).Row

Eğer tablonuz standart ise isinizi gorecektir G48 verilerinizin gelecegi son satirdir .
Eger verileriniz 33 satirdan fazla olursa isinizi görmez.

çok teşekkür ediyorum arkadaşlar tam olarak işimi gördü. çok sağolun.