makro ile dizi formül yardımı

[spacebar]

değerli üstadlarım bir sayfadan başka bir sayfaya makro ile veri aktarımı yapmayı amaçlıyorum. değerli emekleriniz için şimdiden teşekkür ederim.

 

[ÖmerFaruk]

Formül mü istiyorsunuz?
Makro mu?
Makro illa dizi formülümü içersin?

 

[spacebar]

üstad aslında iki çözümü de öğrenmek için görmek istiyorum. ama önceliğim makrolu çözüm. çünkü dizi formüllerinden daha hızlı çalışıyor. makronun dizi formülü içermesi şart değil. veri istediğim gibi gelsin fark etmez. ilginize teşekkür ederim.

 

[ÖmerFaruk]

Aşağıdaki kodları kullanabilirsin.
Not: Hücreleri gerektirmedikçe birleştirmeyin.

Sub FormDoldur()
Dim Sh1 As Worksheet, Sh2 As Worksheet, i As Integer, Say As Integer, Liste
    Set Sh1 = Worksheets("Form")
    Set Sh2 = Worksheets("Alış Fatura listesi")
    Sh1.Range("B19:J" & Rows.Count).Clear
    Veri = Sh2.Range("A3:G" & Sh2.Cells.SpecialCells(xlCellTypeLastCell).Row).Value
    ReDim Liste(1 To 9, 1 To 1)
    For i = 1 To UBound(Veri, 1)
        If Veri(i, 4) = Sh1.Range("C7") Then
            Say = Say + 1
            ReDim Preserve Liste(1 To 9, 1 To Say)
            Liste(1, Say) = CDbl(Veri(i, 2))
            Liste(3, Say) = Veri(i, 3)
            Liste(4, Say) = Veri(i, 5)
            Liste(7, Say) = Veri(i, 7)
        End If
    Next i
    Sh1.Range("B19").Resize(Say, 9) = Application.Transpose(Liste)
    Sh1.Range("B19").Resize(Say, 1).NumberFormat = "dd/mm/yyyy"
    Sh1.Range("E19").Resize(Say, 1).NumberFormat = "#,##.00"
    Sh1.Range("H19").Resize(Say, 1).NumberFormat = "#,##.00"
    
    Sh1.Range("B19").Resize(Say, 2).Merge (True)
    Sh1.Range("B18").Resize(Say + 1, 3).HorizontalAlignment = 2
    Sh1.Range("B18").Resize(Say + 1, 3).IndentLevel = 1
    Sh1.Range("E18").Resize(Say + 1, 3).Merge (True)
    Sh1.Range("H18").Resize(Say + 1, 3).Merge (True)
    Sh1.Range("E18").Resize(Say + 1, 6).HorizontalAlignment = xlRight
    Sh1.Range("E18").Resize(Say + 1, 6).AddIndent = False
    Sh1.Range("E18").Resize(Say + 1, 6).IndentLevel = 1
End Sub

 

[spacebar]

üstad ellerinize sağlık. mükemmel çalışıyor. ancak verileri biçimlendirme yapmadan gelmesi sağlanabilir mi. teşekkür ederim.

 

[ÖmerFaruk]

Next i
Sh1.Range("B19").Resize(Say, 9) = Application.Transpose(Liste)
....
satırından sonrasını silebilirsin.

 

[spacebar]

tamam üstadım. çok teşekkür ederim. ellerinize sağlık.