Bir tablodaki değerleri baz alarak başka bir tabloya değer atamak

[amenejist]

Arkadaşlar sorunumu ekte vermiş olduğum Örnek.xls dosyasında ayrıntılı olarak yazdım.
Problemimi çözmeye yardımcı olacak arkadaşlara şimdiden çok teşekkür ederim...

 

[Korhan Ayhan]

Selamlar,

Lütfen aynı konu ile ilgili ayrı başlıklar açmayınız.

 

[amenejist]

Özür

Korhan Bey aynı konu başlığını kullandığım için özür dilerim.
Konu başlığı aynı ama içerik farklı. Daha doğrusu sorduğum soruda bazı kriter değişiklikleri oldu. Ben de konuyu hızlandırmak açısından aynı konu başlığını kullandım.
Eğer bana tekrardan kızmazsanız aynı dosyayı tekrar eklemek istiyorum.
Yardımlarından dolayı bütün arkadaşlara teşekkür ederim...

 

[omerceri]

Aşağıdaki kod işini görür.
Sub yaz()

For i = 2 To 8

If Range("B" & i) > 0 Then
deger = Range("B" & i)
satir = deger + satir
Range("E" & (satir + 2) - deger).Value = Range("A" & i)
End If
Next
End Sub

 

[omerceri]

Yeni duruma göre kodlar aşağıda
Sub yaz()

For i = 2 To Range("A1").CurrentRegion.Rows.Count

If Range("B" & i) > 0 Then
deger = Range("B" & i)
satir = deger + satir
For e = (satir + 2) - deger To (satir + 2)
Range("E" & e).Value = Range("A" & i)
Next
End If
Next
Range("E" & Range("E1").CurrentRegion.Rows.Count).Delete
End Sub

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak aşağıdaki koduda kullanabilirsiniz.

Sub DEĞER_GİR()
    [E2:E65536].ClearContents
    For X = 2 To [A65536].End(3).Row
    If Cells(X, 2) > 0 Then
    For Y = 1 To Cells(X, 2)
    Cells([E65536].End(3).Row + 1, 5) = Cells(X, 1)
    Next
    End If
    Next
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[amenejist]

Teşekkür

Korhan ve Ömer Bey yardımlarınızdan dolayı teşekkür ederim.