Sayi Kadar Yazdir.

[yteizme]

..............

 

[Seyit Tiken]

Ben soruyu böyle anladım.

Sub Düğme1_Tıklat()
For s = 2 To [B2] + 1
Cells(s, 1).Value = [A2]
Next
End Sub

 

[yteizme]

..............

 

[uzmanamele]

merhaba
bu kodları denermisiniz
Sub deneme()
i = 0
j = 0
Range("c:c").ClearContents
For i = 2 To [B2] + 1
Cells(i, 3).Value = [A2]
Next
For j = 1 To [B3]
Cells((j + i), 3).Value = [A3]
Next
End Sub

 

[yteizme]

...........

 

[uzmanamele]

merhaba
bu kodları denermisiniz
Sub deneme_2()
i = 0
j = 0
ad1 = Range("a2").Value
ad2 = Range("a3").Value
Range("a4:a65536").ClearContents
For i = 5 To [B2] + 4
Cells(i, 1).Value = ad1
Next
For j = 0 To [B3] - 1
Cells((j + i), 1).Value = ad2
Next
End Sub

 

[yteizme]

..............

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub LİSTELE()
    Columns(3).ClearContents
    Satır = 2
    For X = 2 To [A65536].End(3).Row
    If Cells(X, 1) <> "" And Cells(X, 2) <> "" Then
    Range(Cells(Sat&#305;r, 3), Cells(Sat&#305;r - 1 + Cells(X, 2), 3)) = Cells(X, 1)
    Sat&#305;r = [C65536].End(3).Offset(1).Row
    End If
    Next
    MsgBox "&#304;&#350;LEM&#304;N&#304;Z TAMAMLANMI&#350;TIR.", vbInformation
End Sub

 

[yteizme]

..........

 

[yteizme]

...........

 

[Korhan Ayhan]

Selamlar,

Gerçi siz mesajlarınızı silmişsiniz ama ben cevabı hazırlamıştım. Ekteki örnek dosyayı incelermisiniz. Umarım isteğinizi doğru anlamışımdır.

 

[yteizme]

emeğinize sağlık ,inceledim,yanlız şöyle bir sorun mevcut.Dosya ekte..

gereksiz yer işgal etmesin ve problem sonuca kavuşmadığı için silmiştim.

 

[Korhan Ayhan]

Selamlar,

Tam olarak test etmedim ama aşağıdaki kodu denermisiniz.

Sub LİSTELE()
    Range("J:J,K:K,M:M,N:N").ClearContents
    SAYAÇ = 1
    SATIR1 = 2
    For X = 2 To [A65536].End(3).Row
    If Cells(X, 1) <> "" Then
    SAY_A = WorksheetFunction.CountIf([A:A], Cells(X, 1))
    SAY_E = WorksheetFunction.CountIf([E:E], Cells(X, 1))
    If SAY_E = 0 Then
    Range(Cells(SATIR1, 10), Cells(SATIR1 - 1 + Cells(X, 3), 10)) = Cells(X, 1)
    Range(Cells(SATIR1, 11), Cells(SATIR1 - 1 + Cells(X, 3), 11)) = Cells(X, 2)
    Range(Cells(SATIR1, 13), Cells(SATIR1 - 1 + Cells(X, 3), 14)) = 0
    SATIR1 = [J65536].End(3).Row + 1
    Else
    Set BUL = [E:E].Find(Cells(X, 1), LookAt:=xlWhole)
    If Not BUL Is Nothing Then
    ADRES = BUL.Address
    Do
    If SAYA&#199; = Cells(BUL.Row, 7) Then GoTo DEVAM
    If SAYA&#199; <= 1 Then
    Range(Cells(SATIR1, 10), Cells(SATIR1 - 1 + Cells(X, 3) * Cells(BUL.Row, 7), 10)) = Cells(X, 1)
    Range(Cells(SATIR1, 11), Cells(SATIR1 - 1 + Cells(X, 3) * Cells(BUL.Row, 7), 11)) = Cells(X, 2)
    Range(Cells(SATIR1, 13), Cells(SATIR1 - 1 + Cells(X, 3), 13)) = Cells(BUL.Row, 5)
    Range(Cells(SATIR1, 14), Cells(SATIR1 - 1 + Cells(X, 3), 14)) = Cells(BUL.Row, 6)
    SATIR1 = [J65536].End(3).Row + 1
    End If
    If SAY_E > 1 Then
    Set BUL = [E:E].FindNext(BUL)
    SATIR2 = (Cells(X, 3) * Cells(BUL.Row, 7)) / SAY_E
    Range(Cells([M65536].End(3).Row + 1, 13), Cells(SATIR2 + [M65536].End(3).Row, 13)) = Cells(BUL.Row, 5)
    Range(Cells([N65536].End(3).Row + 1, 14), Cells(SATIR2 + [N65536].End(3).Row, 14)) = Cells(BUL.Row, 6)
    End If
    SAYA&#199; = SAYA&#199; + 1
    Loop While Not BUL Is Nothing And BUL.Address <> ADRES
    SATIR1 = [J65536].End(3).Row + 1
    End If
    End If
DEVAM:
    SATIR1 = [J65536].End(3).Row + 1
    End If
    SAYA&#199; = 0
    Next
    MsgBox "&#304;&#350;LEM&#304;N&#304;Z TAMAMLANMI&#350;TIR.", vbInformation
End Sub

 

[yteizme]

....................